source: trunk/gui/scripts/vtkmeshviewer.tcl @ 5092

Last change on this file since 5092 was 5092, checked in by ldelgass, 6 years ago

Add update in Rebuild to allow initial canvas size to be set. We don't want to
do this in the constructor since that can cause an error when the add method is
called before the constructor returns.

File size: 54.7 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: vtkmeshviewer - Vtk mesh viewer
4#
5#  It connects to the Vtk server running on a rendering farm,
6#  transmits data, and displays the results.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2014  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
15package require BLT
16#package require Img
17
18option add *VtkMeshViewer.width 4i widgetDefault
19option add *VtkMeshViewer*cursor crosshair widgetDefault
20option add *VtkMeshViewer.height 4i widgetDefault
21option add *VtkMeshViewer.foreground black widgetDefault
22option add *VtkMeshViewer.controlBackground gray widgetDefault
23option add *VtkMeshViewer.controlDarkBackground #999999 widgetDefault
24option add *VtkMeshViewer.plotBackground black widgetDefault
25option add *VtkMeshViewer.plotForeground white widgetDefault
26option add *VtkMeshViewer.font \
27    -*-helvetica-medium-r-normal-*-12-* widgetDefault
28
29# must use this name -- plugs into Rappture::resources::load
30proc VtkMeshViewer_init_resources {} {
31    Rappture::resources::register \
32        vtkvis_server Rappture::VtkMeshViewer::SetServerList
33}
34
35itcl::class Rappture::VtkMeshViewer {
36    inherit Rappture::VisViewer
37
38    itk_option define -plotforeground plotForeground Foreground ""
39    itk_option define -plotbackground plotBackground Background ""
40
41    constructor { hostlist args } {
42        Rappture::VisViewer::constructor $hostlist
43    } {
44        # defined below
45    }
46    destructor {
47        # defined below
48    }
49    public proc SetServerList { namelist } {
50        Rappture::VisViewer::SetServerList "vtkvis" $namelist
51    }
52    public method add {dataobj {settings ""}}
53    public method camera {option args}
54    public method delete {args}
55    public method disconnect {}
56    public method download {option args}
57    public method get {args}
58    public method isconnected {}
59    public method limits { dataobj }
60    public method parameters {title args} {
61        # do nothing
62    }
63    public method scale {args}
64
65    # The following methods are only used by this class.
66    private method AdjustSetting {what {value ""}}
67    private method BuildAxisTab {}
68    private method BuildCameraTab {}
69    private method BuildDownloadPopup { widget command }
70    private method BuildPolydataTab {}
71    private method Connect {}
72    private method CurrentDatasets {args}
73    private method Disconnect {}
74    private method DoResize {}
75    private method DoRotate {}
76    private method EventuallyResize { w h }
77    private method EventuallyRotate { q }
78    private method EventuallySetPolydataOpacity {}
79    private method GetImage { args }
80    private method GetVtkData { args }
81    private method InitSettings { args  }
82    private method IsValidObject { dataobj }
83    private method Pan {option x y}
84    private method PanCamera {}
85    private method Pick {x y}
86    private method QuaternionToView { q } {
87        foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break
88    }
89    private method Rebuild {}
90    private method ReceiveDataset { args }
91    private method ReceiveImage { args }
92    private method Rotate {option x y}
93    private method SetObjectStyle { dataobj }
94    private method SetOrientation { side }
95    private method SetPolydataOpacity {}
96    private method ViewToQuaternion {} {
97        return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)]
98    }
99    private method Zoom {option}
100
101    private variable _arcball ""
102    private variable _dlist "";         # list of data objects
103    private variable _obj2datasets
104    private variable _obj2ovride;       # maps dataobj => style override
105    private variable _datasets;         # contains all the dataobj-component
106                                        # datasets in the server
107    private variable _dataset2style;    # maps dataobj-component to transfunc
108    private variable _style2datasets;   # maps tf back to list of
109                                        # dataobj-components using the tf.
110    private variable _click;            # info used for rotate operations
111    private variable _limits;           # autoscale min/max for all axes
112    private variable _view;             # view params for 3D view
113    private variable _settings
114    private variable _widget
115    private variable _style;            # Array of current component styles.
116    private variable _initialStyle;     # Array of initial component styles.
117    private variable _reset 1;          # Indicates that server was reset and
118                                        # needs to be reinitialized.
119
120    private variable _first "";         # This is the topmost dataset.
121    private variable _start 0
122    private variable _title ""
123
124    common _downloadPopup;              # download options from popup
125    private common _hardcopy
126    private variable _width 0
127    private variable _height 0
128    private variable _resizePending 0
129    private variable _rotatePending 0
130    private variable _polydataOpacityPending 0
131    private variable _rotateDelay 150
132    private variable _opacityDelay 150
133}
134
135itk::usual VtkMeshViewer {
136    keep -background -foreground -cursor -font
137    keep -plotbackground -plotforeground
138}
139
140# ----------------------------------------------------------------------
141# CONSTRUCTOR
142# ----------------------------------------------------------------------
143itcl::body Rappture::VtkMeshViewer::constructor {hostlist args} {
144    package require vtk
145    set _serverType "vtkvis"
146
147    # Rebuild event
148    $_dispatcher register !rebuild
149    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
150
151    # Resize event
152    $_dispatcher register !resize
153    $_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
154
155    # Rotate event
156    $_dispatcher register !rotate
157    $_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
158
159    # Polydata opacity event
160    $_dispatcher register !polydataOpacity
161    $_dispatcher dispatch $this !polydataOpacity \
162        "[itcl::code $this SetPolydataOpacity]; list"
163    #
164    # Populate parser with commands handle incoming requests
165    #
166    $_parser alias image [itcl::code $this ReceiveImage]
167    $_parser alias dataset [itcl::code $this ReceiveDataset]
168
169    # Initialize the view to some default parameters.
170    array set _view {
171        -ortho           0
172        -qw              0.853553
173        -qx              -0.353553
174        -qy              0.353553
175        -qz              0.146447
176        -xpan            0
177        -ypan            0
178        -zoom            1.0
179    }
180    set _arcball [blt::arcball create 100 100]
181    $_arcball quaternion [ViewToQuaternion]
182
183    set _limits(zmin) 0.0
184    set _limits(zmax) 1.0
185
186    array set _settings {
187        -axesvisible            1
188        -axislabels             1
189        -axisminorticks         1
190        -outline                0
191        -polydataedges          0
192        -polydatalighting       1
193        -polydataopacity        1.0
194        -polydatavisible        1
195        -polydatawireframe      0
196        -xgrid                  0
197        -ygrid                  0
198        -zgrid                  0
199    }
200    array set _widget {
201        -polydataopacity        100
202    }
203    itk_component add view {
204        canvas $itk_component(plotarea).view \
205            -highlightthickness 0 -borderwidth 0
206    } {
207        usual
208        ignore -highlightthickness -borderwidth  -background
209    }
210
211    itk_component add fieldmenu {
212        menu $itk_component(plotarea).menu -bg black -fg white -relief flat \
213            -tearoff no
214    } {
215        usual
216        ignore -background -foreground -relief -tearoff
217    }
218
219    set c $itk_component(view)
220    bind $c <Configure> [itcl::code $this EventuallyResize %w %h]
221    bind $c <4> [itcl::code $this Zoom in 0.25]
222    bind $c <5> [itcl::code $this Zoom out 0.25]
223    bind $c <KeyPress-Left>  [list %W xview scroll 10 units]
224    bind $c <KeyPress-Right> [list %W xview scroll -10 units]
225    bind $c <KeyPress-Up>    [list %W yview scroll 10 units]
226    bind $c <KeyPress-Down>  [list %W yview scroll -10 units]
227    bind $c <Enter> "focus %W"
228    bind $c <Control-F1> [itcl::code $this ToggleConsole]
229
230    # Fix the scrollregion in case we go off screen
231    $c configure -scrollregion [$c bbox all]
232
233    set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
234    set _map(cwidth) -1
235    set _map(cheight) -1
236    set _map(zoom) 1.0
237    set _map(original) ""
238
239    set f [$itk_component(main) component controls]
240    itk_component add reset {
241        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
242            -highlightthickness 0 \
243            -image [Rappture::icon reset-view] \
244            -command [itcl::code $this Zoom reset]
245    } {
246        usual
247        ignore -highlightthickness
248    }
249    pack $itk_component(reset) -side top -padx 2 -pady 2
250    Rappture::Tooltip::for $itk_component(reset) \
251        "Reset the view to the default zoom level"
252
253    itk_component add zoomin {
254        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
255            -highlightthickness 0 \
256            -image [Rappture::icon zoom-in] \
257            -command [itcl::code $this Zoom in]
258    } {
259        usual
260        ignore -highlightthickness
261    }
262    pack $itk_component(zoomin) -side top -padx 2 -pady 2
263    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
264
265    itk_component add zoomout {
266        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
267            -highlightthickness 0 \
268            -image [Rappture::icon zoom-out] \
269            -command [itcl::code $this Zoom out]
270    } {
271        usual
272        ignore -highlightthickness
273    }
274    pack $itk_component(zoomout) -side top -padx 2 -pady 2
275    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
276
277    BuildPolydataTab
278    BuildAxisTab
279    BuildCameraTab
280
281    # Hack around the Tk panewindow.  The problem is that the requested
282    # size of the 3d view isn't set until an image is retrieved from
283    # the server.  So the panewindow uses the tiny size.
284    set w 10000
285    pack forget $itk_component(view)
286    blt::table $itk_component(plotarea) \
287        0,0 $itk_component(view) -fill both -reqwidth $w
288    blt::table configure $itk_component(plotarea) c1 -resize none
289
290    # Bindings for rotation via mouse
291    bind $itk_component(view) <ButtonPress-1> \
292        [itcl::code $this Rotate click %x %y]
293    bind $itk_component(view) <B1-Motion> \
294        [itcl::code $this Rotate drag %x %y]
295    bind $itk_component(view) <ButtonRelease-1> \
296        [itcl::code $this Rotate release %x %y]
297
298    # Bindings for panning via mouse
299    bind $itk_component(view) <ButtonPress-2> \
300        [itcl::code $this Pan click %x %y]
301    bind $itk_component(view) <B2-Motion> \
302        [itcl::code $this Pan drag %x %y]
303    bind $itk_component(view) <ButtonRelease-2> \
304        [itcl::code $this Pan release %x %y]
305
306    #bind $itk_component(view) <ButtonRelease-3> \
307    #    [itcl::code $this Pick %x %y]
308
309    # Bindings for panning via keyboard
310    bind $itk_component(view) <KeyPress-Left> \
311        [itcl::code $this Pan set -10 0]
312    bind $itk_component(view) <KeyPress-Right> \
313        [itcl::code $this Pan set 10 0]
314    bind $itk_component(view) <KeyPress-Up> \
315        [itcl::code $this Pan set 0 -10]
316    bind $itk_component(view) <KeyPress-Down> \
317        [itcl::code $this Pan set 0 10]
318    bind $itk_component(view) <Shift-KeyPress-Left> \
319        [itcl::code $this Pan set -2 0]
320    bind $itk_component(view) <Shift-KeyPress-Right> \
321        [itcl::code $this Pan set 2 0]
322    bind $itk_component(view) <Shift-KeyPress-Up> \
323        [itcl::code $this Pan set 0 -2]
324    bind $itk_component(view) <Shift-KeyPress-Down> \
325        [itcl::code $this Pan set 0 2]
326
327    # Bindings for zoom via keyboard
328    bind $itk_component(view) <KeyPress-Prior> \
329        [itcl::code $this Zoom out]
330    bind $itk_component(view) <KeyPress-Next> \
331        [itcl::code $this Zoom in]
332
333    bind $itk_component(view) <Enter> "focus $itk_component(view)"
334
335    if {[string equal "x11" [tk windowingsystem]]} {
336        # Bindings for zoom via mouse
337        bind $itk_component(view) <4> [itcl::code $this Zoom out]
338        bind $itk_component(view) <5> [itcl::code $this Zoom in]
339    }
340
341    set _image(download) [image create photo]
342
343    eval itk_initialize $args
344    Connect
345}
346
347# ----------------------------------------------------------------------
348# DESTRUCTOR
349# ----------------------------------------------------------------------
350itcl::body Rappture::VtkMeshViewer::destructor {} {
351    Disconnect
352    $_dispatcher cancel !rebuild
353    $_dispatcher cancel !resize
354    $_dispatcher cancel !rotate
355    image delete $_image(plot)
356    image delete $_image(download)
357    catch { blt::arcball destroy $_arcball }
358}
359
360itcl::body Rappture::VtkMeshViewer::DoResize {} {
361    if { $_width < 2 } {
362        set _width 500
363    }
364    if { $_height < 2 } {
365        set _height 500
366    }
367    set _start [clock clicks -milliseconds]
368    SendCmd "screen size $_width $_height"
369
370    set _resizePending 0
371}
372
373itcl::body Rappture::VtkMeshViewer::DoRotate {} {
374    SendCmd "camera orient [ViewToQuaternion]"
375    set _rotatePending 0
376}
377
378itcl::body Rappture::VtkMeshViewer::EventuallyResize { w h } {
379    set _width $w
380    set _height $h
381    $_arcball resize $w $h
382    if { !$_resizePending } {
383        set _resizePending 1
384        $_dispatcher event -after 200 !resize
385    }
386}
387
388itcl::body Rappture::VtkMeshViewer::EventuallyRotate { q } {
389    QuaternionToView $q
390    if { !$_rotatePending } {
391        set _rotatePending 1
392        $_dispatcher event -after $_rotateDelay !rotate
393    }
394}
395
396itcl::body Rappture::VtkMeshViewer::SetPolydataOpacity {} {
397    set _polydataOpacityPending 0
398    set val $_settings(-polydataopacity)
399    SendCmd "polydata opacity $val"
400}
401
402itcl::body Rappture::VtkMeshViewer::EventuallySetPolydataOpacity {} {
403    if { !$_polydataOpacityPending } {
404        set _polydataOpacityPending 1
405        $_dispatcher event -after $_opacityDelay !polydataOpacity
406    }
407}
408
409# ----------------------------------------------------------------------
410# USAGE: add <dataobj> ?<settings>?
411#
412# Clients use this to add a data object to the plot.  The optional
413# <settings> are used to configure the plot.  Allowed settings are
414# -color, -brightness, -width, -linestyle, and -raise.
415# ----------------------------------------------------------------------
416itcl::body Rappture::VtkMeshViewer::add {dataobj {settings ""}} {
417    array set params {
418        -color auto
419        -width 1
420        -linestyle solid
421        -brightness 0
422        -raise 0
423        -description ""
424        -param ""
425        -type ""
426    }
427    array set params $settings
428    set params(-description) ""
429    set params(-param) ""
430    array set params $settings
431
432    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
433        # can't handle -autocolors yet
434        set params(-color) black
435    }
436    set pos [lsearch -exact $_dlist $dataobj]
437    if {$pos < 0} {
438        lappend _dlist $dataobj
439    }
440    set _obj2ovride($dataobj-color) $params(-color)
441    set _obj2ovride($dataobj-width) $params(-width)
442    set _obj2ovride($dataobj-raise) $params(-raise)
443    $_dispatcher event -idle !rebuild
444}
445
446# ----------------------------------------------------------------------
447# USAGE: delete ?<dataobj1> <dataobj2> ...?
448#
449#       Clients use this to delete a dataobj from the plot.  If no dataobjs
450#       are specified, then all dataobjs are deleted.  No data objects are
451#       deleted.  They are only removed from the display list.
452#
453# ----------------------------------------------------------------------
454itcl::body Rappture::VtkMeshViewer::delete {args} {
455    if { [llength $args] == 0} {
456        set args $_dlist
457    }
458    # Delete all specified dataobjs
459    set changed 0
460    foreach dataobj $args {
461        set pos [lsearch -exact $_dlist $dataobj]
462        if { $pos < 0 } {
463            continue;                   # Don't know anything about it.
464        }
465        # Remove it from the dataobj list.
466        set _dlist [lreplace $_dlist $pos $pos]
467        array unset _obj2ovride $dataobj-*
468        set changed 1
469    }
470    # If anything changed, then rebuild the plot
471    if { $changed } {
472        $_dispatcher event -idle !rebuild
473    }
474}
475
476# ----------------------------------------------------------------------
477# USAGE: get ?-objects?
478# USAGE: get ?-visible?
479# USAGE: get ?-image view?
480#
481# Clients use this to query the list of objects being plotted, in
482# order from bottom to top of this result.  The optional "-image"
483# flag can also request the internal images being shown.
484# ----------------------------------------------------------------------
485itcl::body Rappture::VtkMeshViewer::get {args} {
486    if {[llength $args] == 0} {
487        set args "-objects"
488    }
489
490    set op [lindex $args 0]
491    switch -- $op {
492        "-objects" {
493            # put the dataobj list in order according to -raise options
494            set dlist {}
495            foreach dataobj $_dlist {
496                if { ![IsValidObject $dataobj] } {
497                    continue
498                }
499                if {[info exists _obj2ovride($dataobj-raise)] &&
500                    $_obj2ovride($dataobj-raise)} {
501                    set dlist [linsert $dlist 0 $dataobj]
502                } else {
503                    lappend dlist $dataobj
504                }
505            }
506            return $dlist
507        }
508        "-visible" {
509            set dlist {}
510            foreach dataobj $_dlist {
511                if { ![IsValidObject $dataobj] } {
512                    continue
513                }
514                if { ![info exists _obj2ovride($dataobj-raise)] } {
515                    # No setting indicates that the object isn't visible.
516                    continue
517                }
518                # Otherwise use the -raise parameter to put the object to
519                # the front of the list.
520                if { $_obj2ovride($dataobj-raise) } {
521                    set dlist [linsert $dlist 0 $dataobj]
522                } else {
523                    lappend dlist $dataobj
524                }
525            }
526            return $dlist
527        }
528        -image {
529            if {[llength $args] != 2} {
530                error "wrong # args: should be \"get -image view\""
531            }
532            switch -- [lindex $args end] {
533                view {
534                    return $_image(plot)
535                }
536                default {
537                    error "bad image name \"[lindex $args end]\": should be view"
538                }
539            }
540        }
541        default {
542            error "bad option \"$op\": should be -objects or -image"
543        }
544    }
545}
546
547# ----------------------------------------------------------------------
548# USAGE: scale ?<data1> <data2> ...?
549#
550# Sets the default limits for the overall plot according to the
551# limits of the data for all of the given <data> objects.  This
552# accounts for all objects--even those not showing on the screen.
553# Because of this, the limits are appropriate for all objects as
554# the user scans through data in the ResultSet viewer.
555# ----------------------------------------------------------------------
556itcl::body Rappture::VtkMeshViewer::scale {args} {
557    foreach dataobj $args {
558        array set bounds [limits $dataobj]
559        if {![info exists _limits(xmin)] || $_limits(xmin) > $bounds(xmin)} {
560            set _limits(xmin) $bounds(xmin)
561        }
562        if {![info exists _limits(xmax)] || $_limits(xmax) < $bounds(xmax)} {
563            set _limits(xmax) $bounds(xmax)
564        }
565
566        if {![info exists _limits(ymin)] || $_limits(ymin) > $bounds(ymin)} {
567            set _limits(ymin) $bounds(ymin)
568        }
569        if {![info exists _limits(ymax)] || $_limits(ymax) < $bounds(ymax)} {
570            set _limits(ymax) $bounds(ymax)
571        }
572
573        if {![info exists _limits(zmin)] || $_limits(zmin) > $bounds(zmin)} {
574            set _limits(zmin) $bounds(zmin)
575        }
576        if {![info exists _limits(zmax)] || $_limits(zmax) < $bounds(zmax)} {
577            set _limits(zmax) $bounds(zmax)
578        }
579    }
580}
581
582# ----------------------------------------------------------------------
583# USAGE: download coming
584# USAGE: download controls <downloadCommand>
585# USAGE: download now
586#
587# Clients use this method to create a downloadable representation
588# of the plot.  Returns a list of the form {ext string}, where
589# "ext" is the file extension (indicating the type of data) and
590# "string" is the data itself.
591# ----------------------------------------------------------------------
592itcl::body Rappture::VtkMeshViewer::download {option args} {
593    switch $option {
594        coming {
595            if {[catch {
596                blt::winop snap $itk_component(plotarea) $_image(download)
597            }]} {
598                $_image(download) configure -width 1 -height 1
599                $_image(download) put #000000
600            }
601        }
602        controls {
603            set popup .vtkviewerdownload
604            if { ![winfo exists .vtkviewerdownload] } {
605                set inner [BuildDownloadPopup $popup [lindex $args 0]]
606            } else {
607                set inner [$popup component inner]
608            }
609            set _downloadPopup(image_controls) $inner.image_frame
610            set num [llength [get]]
611            set num [expr {($num == 1) ? "1 result" : "$num results"}]
612            set word [Rappture::filexfer::label downloadWord]
613            $inner.summary configure -text "$word $num in the following format:"
614            update idletasks            ;# Fix initial sizes
615            return $popup
616        }
617        now {
618            set popup .vtkviewerdownload
619            if {[winfo exists .vtkviewerdownload]} {
620                $popup deactivate
621            }
622            switch -- $_downloadPopup(format) {
623                "image" {
624                    return [$this GetImage [lindex $args 0]]
625                }
626                "vtk" {
627                    return [$this GetVtkData [lindex $args 0]]
628                }
629            }
630            return ""
631        }
632        default {
633            error "bad option \"$option\": should be coming, controls, now"
634        }
635    }
636}
637
638# ----------------------------------------------------------------------
639# USAGE: Connect ?<host:port>,<host:port>...?
640#
641# Clients use this method to establish a connection to a new
642# server, or to reestablish a connection to the previous server.
643# Any existing connection is automatically closed.
644# ----------------------------------------------------------------------
645itcl::body Rappture::VtkMeshViewer::Connect {} {
646    global readyForNextFrame
647    set readyForNextFrame 1
648    set _hosts [GetServerList "vtkvis"]
649    if { "" == $_hosts } {
650        return 0
651    }
652    set result [VisViewer::Connect $_hosts]
653    if { $result } {
654        if { $_reportClientInfo }  {
655            # Tell the server the viewer, hub, user and session.
656            # Do this immediately on connect before buffering any commands
657            global env
658
659            set info {}
660            set user "???"
661            if { [info exists env(USER)] } {
662                set user $env(USER)
663            }
664            set session "???"
665            if { [info exists env(SESSION)] } {
666                set session $env(SESSION)
667            }
668            lappend info "version" "$Rappture::version"
669            lappend info "build" "$Rappture::build"
670            lappend info "svnurl" "$Rappture::svnurl"
671            lappend info "installdir" "$Rappture::installdir"
672            lappend info "hub" [exec hostname]
673            lappend info "client" "vtkmeshviewer"
674            lappend info "user" $user
675            lappend info "session" $session
676            SendCmd "clientinfo [list $info]"
677        }
678
679        set w [winfo width $itk_component(view)]
680        set h [winfo height $itk_component(view)]
681        EventuallyResize $w $h
682    }
683    return $result
684}
685
686#
687# isconnected --
688#
689#       Indicates if we are currently connected to the visualization server.
690#
691itcl::body Rappture::VtkMeshViewer::isconnected {} {
692    return [VisViewer::IsConnected]
693}
694
695#
696# disconnect --
697#
698itcl::body Rappture::VtkMeshViewer::disconnect {} {
699    Disconnect
700    set _reset 1
701}
702
703#
704# Disconnect --
705#
706#       Clients use this method to disconnect from the current rendering
707#       server.
708#
709itcl::body Rappture::VtkMeshViewer::Disconnect {} {
710    VisViewer::Disconnect
711
712    # disconnected -- no more data sitting on server
713    array unset _datasets
714    array unset _data
715    global readyForNextFrame
716    set readyForNextFrame 1
717}
718
719# ----------------------------------------------------------------------
720# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
721#
722# Invoked automatically whenever the "image" command comes in from
723# the rendering server.  Indicates that binary image data with the
724# specified <size> will follow.
725# ----------------------------------------------------------------------
726itcl::body Rappture::VtkMeshViewer::ReceiveImage { args } {
727    global readyForNextFrame
728    set readyForNextFrame 1
729    array set info {
730        -token "???"
731        -bytes 0
732        -type image
733    }
734    array set info $args
735    set bytes [ReceiveBytes $info(-bytes)]
736    if { $info(-type) == "image" } {
737        if 0 {
738            set f [open "last.ppm" "w"]
739            fconfigure $f -encoding binary
740            puts -nonewline $f $bytes
741            close $f
742        }
743        $_image(plot) configure -data $bytes
744        set time [clock seconds]
745        set date [clock format $time]
746        if { $_start > 0 } {
747            set finish [clock clicks -milliseconds]
748            set _start 0
749        }
750    } elseif { $info(type) == "print" } {
751        set tag $this-print-$info(-token)
752        set _hardcopy($tag) $bytes
753    }
754}
755
756#
757# ReceiveDataset --
758#
759itcl::body Rappture::VtkMeshViewer::ReceiveDataset { args } {
760    if { ![isconnected] } {
761        return
762    }
763    set option [lindex $args 0]
764    switch -- $option {
765        "scalar" {
766            set option [lindex $args 1]
767            switch -- $option {
768                "world" {
769                    foreach { x y z value tag } [lrange $args 2 end] break
770                }
771                "pixel" {
772                    foreach { x y value tag } [lrange $args 2 end] break
773                }
774            }
775        }
776        "vector" {
777            set option [lindex $args 1]
778            switch -- $option {
779                "world" {
780                    foreach { x y z vx vy vz tag } [lrange $args 2 end] break
781                }
782                "pixel" {
783                    foreach { x y vx vy vz tag } [lrange $args 2 end] break
784                }
785            }
786        }
787        "names" {
788            foreach { name } [lindex $args 1] {
789                #puts stderr "Dataset: $name"
790            }
791        }
792        default {
793            error "unknown dataset option \"$option\" from server"
794        }
795    }
796}
797
798# ----------------------------------------------------------------------
799# USAGE: Rebuild
800#
801# Called automatically whenever something changes that affects the
802# data in the widget.  Clears any existing data and rebuilds the
803# widget to display new data.
804# ----------------------------------------------------------------------
805itcl::body Rappture::VtkMeshViewer::Rebuild {} {
806    set w [winfo width $itk_component(view)]
807    set h [winfo height $itk_component(view)]
808    if { $w < 2 || $h < 2 } {
809        update
810        $_dispatcher event -idle !rebuild
811        return
812    }
813
814    # Turn on buffering of commands to the server.  We don't want to
815    # be preempted by a server disconnect/reconnect (which automatically
816    # generates a new call to Rebuild).
817    StartBufferingCommands
818
819    if { $_reset } {
820        set _width $w
821        set _height $h
822        $_arcball resize $w $h
823        DoResize
824        InitSettings -xgrid -ygrid -zgrid -axismode \
825            -axesvisible -axislabels -axisminorticks
826        StopBufferingCommands
827        SendCmd "imgflush"
828        StartBufferingCommands
829    }
830
831    set _limits(zmin) ""
832    set _limits(zmax) ""
833    set _first ""
834    SendCmd "dataset visible 0"
835    set count 0
836    foreach dataobj [get -objects] {
837        if { [info exists _obj2ovride($dataobj-raise)] &&  $_first == "" } {
838            set _first $dataobj
839        }
840        set _obj2datasets($dataobj) ""
841        set tag $dataobj
842        if { ![info exists _datasets($tag)] } {
843            set bytes [$dataobj vtkdata -full]
844            if { $bytes == "" } {
845                continue
846            }
847            if 0 {
848                set f [open /tmp/vtkmesh.vtk "w"]
849                fconfigure $f -translation binary -encoding binary
850                puts -nonewline $f $bytes
851                close $f
852            }
853            set length [string length $bytes]
854            if { $_reportClientInfo }  {
855                set info {}
856                lappend info "tool_id"       [$dataobj hints toolid]
857                lappend info "tool_name"     [$dataobj hints toolname]
858                lappend info "tool_title"    [$dataobj hints tooltitle]
859                lappend info "tool_command"  [$dataobj hints toolcommand]
860                lappend info "tool_revision" [$dataobj hints toolrevision]
861                lappend info "dataset_label" [$dataobj hints label]
862                lappend info "dataset_size"  $length
863                lappend info "dataset_tag"   $tag
864                SendCmd "clientinfo [list $info]"
865            }
866            SendCmd "dataset add $tag data follows $length"
867            append _outbuf $bytes
868            set _datasets($tag) 1
869            SetObjectStyle $dataobj
870        }
871        lappend _obj2datasets($dataobj) $tag
872        if { [info exists _obj2ovride($dataobj-raise)] } {
873            SendCmd "dataset visible 1 $tag"
874            EventuallySetPolydataOpacity
875        }
876    }
877    if {"" != $_first} {
878        set location [$_first hints camera]
879        if { $location != "" } {
880            array set view $location
881        }
882
883        foreach axis { x y z } {
884            set label [$_first label ${axis}]
885            if { $label != "" } {
886                SendCmd [list axis name $axis $label]
887            }
888            set units [$_first units ${axis}]
889            if { $units != "" } {
890                SendCmd [list axis units $axis $units]
891            }
892        }
893    }
894    InitSettings -outline
895    if { $_reset } {
896        # These are settings that rely on a dataset being loaded.
897        InitSettings -polydataedges -polydatalighting -polydataopacity \
898            -polydatavisible -polydatawireframe
899
900        #SendCmd "axis lformat all %g"
901
902        $_arcball quaternion [ViewToQuaternion]
903        SendCmd "camera reset"
904        if { $_view(-ortho)} {
905            SendCmd "camera mode ortho"
906        } else {
907            SendCmd "camera mode persp"
908        }
909        DoRotate
910        PanCamera
911        Zoom reset
912    }
913
914    set _reset 0
915    global readyForNextFrame
916    set readyForNextFrame 0;            # Don't advance to the next frame
917                                        # until we get an image.
918
919    # Actually write the commands to the server socket.  If it fails, we don't
920    # care.  We're finished here.
921    blt::busy hold $itk_component(hull)
922    StopBufferingCommands
923    blt::busy release $itk_component(hull)
924}
925
926# ----------------------------------------------------------------------
927# USAGE: CurrentDatasets ?-all -visible? ?dataobjs?
928#
929# Returns a list of server IDs for the current datasets being displayed.  This
930# is normally a single ID, but it might be a list of IDs if the current data
931# object has multiple components.
932# ----------------------------------------------------------------------
933itcl::body Rappture::VtkMeshViewer::CurrentDatasets {args} {
934    set flag [lindex $args 0]
935    switch -- $flag {
936        "-all" {
937            if { [llength $args] > 1 } {
938                error "CurrentDatasets: can't specify dataobj after \"-all\""
939            }
940            set dlist [get -objects]
941        }
942        "-visible" {
943            if { [llength $args] > 1 } {
944                set dlist {}
945                set args [lrange $args 1 end]
946                foreach dataobj $args {
947                    if { [info exists _obj2ovride($dataobj-raise)] } {
948                        lappend dlist $dataobj
949                    }
950                }
951            } else {
952                set dlist [get -visible]
953            }
954        }
955        default {
956            set dlist $args
957        }
958    }
959    set rlist ""
960    foreach tag $dlist {
961        if { [info exists _datasets($tag)] && $_datasets($tag) } {
962            lappend rlist $tag
963        }
964    }
965    return $rlist
966}
967
968# ----------------------------------------------------------------------
969# USAGE: Zoom in
970# USAGE: Zoom out
971# USAGE: Zoom reset
972#
973# Called automatically when the user clicks on one of the zoom
974# controls for this widget.  Changes the zoom for the current view.
975# ----------------------------------------------------------------------
976itcl::body Rappture::VtkMeshViewer::Zoom {option} {
977    switch -- $option {
978        "in" {
979            set _view(-zoom) [expr {$_view(-zoom)*1.25}]
980            SendCmd "camera zoom $_view(-zoom)"
981        }
982        "out" {
983            set _view(-zoom) [expr {$_view(-zoom)*0.8}]
984            SendCmd "camera zoom $_view(-zoom)"
985        }
986        "reset" {
987            array set _view {
988                -qw      0.853553
989                -qx      -0.353553
990                -qy      0.353553
991                -qz      0.146447
992                -xpan    0
993                -ypan    0
994                -zoom    1.0
995            }
996            if { $_first != "" } {
997                set location [$_first hints camera]
998                if { $location != "" } {
999                    array set _view $location
1000                }
1001            }
1002            $_arcball quaternion [ViewToQuaternion]
1003            DoRotate
1004            SendCmd "camera reset"
1005        }
1006    }
1007}
1008
1009itcl::body Rappture::VtkMeshViewer::PanCamera {} {
1010    set x $_view(-xpan)
1011    set y $_view(-ypan)
1012    SendCmd "camera pan $x $y"
1013}
1014
1015# ----------------------------------------------------------------------
1016# USAGE: Rotate click <x> <y>
1017# USAGE: Rotate drag <x> <y>
1018# USAGE: Rotate release <x> <y>
1019#
1020# Called automatically when the user clicks/drags/releases in the
1021# plot area.  Moves the plot according to the user's actions.
1022# ----------------------------------------------------------------------
1023itcl::body Rappture::VtkMeshViewer::Rotate {option x y} {
1024    switch -- $option {
1025        "click" {
1026            $itk_component(view) configure -cursor fleur
1027            set _click(x) $x
1028            set _click(y) $y
1029        }
1030        "drag" {
1031            if {[array size _click] == 0} {
1032                Rotate click $x $y
1033            } else {
1034                set w [winfo width $itk_component(view)]
1035                set h [winfo height $itk_component(view)]
1036                if {$w <= 0 || $h <= 0} {
1037                    return
1038                }
1039
1040                if {[catch {
1041                    # this fails sometimes for no apparent reason
1042                    set dx [expr {double($x-$_click(x))/$w}]
1043                    set dy [expr {double($y-$_click(y))/$h}]
1044                }]} {
1045                    return
1046                }
1047                if { $dx == 0 && $dy == 0 } {
1048                    return
1049                }
1050                set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1051                EventuallyRotate $q
1052                set _click(x) $x
1053                set _click(y) $y
1054            }
1055        }
1056        "release" {
1057            Rotate drag $x $y
1058            $itk_component(view) configure -cursor ""
1059            catch {unset _click}
1060        }
1061        default {
1062            error "bad option \"$option\": should be click, drag, release"
1063        }
1064    }
1065}
1066
1067itcl::body Rappture::VtkMeshViewer::Pick {x y} {
1068    foreach tag [CurrentDatasets -visible] {
1069        SendCmd "dataset getscalar pixel $x $y $tag"
1070    }
1071}
1072
1073# ----------------------------------------------------------------------
1074# USAGE: $this Pan click x y
1075#        $this Pan drag x y
1076#        $this Pan release x y
1077#
1078# Called automatically when the user clicks on one of the zoom
1079# controls for this widget.  Changes the zoom for the current view.
1080# ----------------------------------------------------------------------
1081itcl::body Rappture::VtkMeshViewer::Pan {option x y} {
1082    switch -- $option {
1083        "set" {
1084            set w [winfo width $itk_component(view)]
1085            set h [winfo height $itk_component(view)]
1086            set x [expr $x / double($w)]
1087            set y [expr $y / double($h)]
1088            set _view(-xpan) [expr $_view(-xpan) + $x]
1089            set _view(-ypan) [expr $_view(-ypan) + $y]
1090            PanCamera
1091            return
1092        }
1093        "click" {
1094            set _click(x) $x
1095            set _click(y) $y
1096            $itk_component(view) configure -cursor hand1
1097        }
1098        "drag" {
1099            if { ![info exists _click(x)] } {
1100                set _click(x) $x
1101            }
1102            if { ![info exists _click(y)] } {
1103                set _click(y) $y
1104            }
1105            set w [winfo width $itk_component(view)]
1106            set h [winfo height $itk_component(view)]
1107            set dx [expr ($_click(x) - $x)/double($w)]
1108            set dy [expr ($_click(y) - $y)/double($h)]
1109            set _click(x) $x
1110            set _click(y) $y
1111            set _view(-xpan) [expr $_view(-xpan) - $dx]
1112            set _view(-ypan) [expr $_view(-ypan) - $dy]
1113            PanCamera
1114        }
1115        "release" {
1116            Pan drag $x $y
1117            $itk_component(view) configure -cursor ""
1118        }
1119        default {
1120            error "unknown option \"$option\": should set, click, drag, or release"
1121        }
1122    }
1123}
1124
1125# ----------------------------------------------------------------------
1126# USAGE: InitSettings <what> ?<value>?
1127#
1128# Used internally to update rendering settings whenever parameters
1129# change in the popup settings panel.  Sends the new settings off
1130# to the back end.
1131# ----------------------------------------------------------------------
1132itcl::body Rappture::VtkMeshViewer::InitSettings { args } {
1133    foreach setting $args {
1134        AdjustSetting $setting
1135    }
1136}
1137
1138#
1139# AdjustSetting --
1140#
1141#       Changes/updates a specific setting in the widget.  There are
1142#       usually user-setable option.  Commands are sent to the render
1143#       server.
1144#
1145itcl::body Rappture::VtkMeshViewer::AdjustSetting {what {value ""}} {
1146    if { ![isconnected] } {
1147        return
1148    }
1149    switch -- $what {
1150        "-outline" {
1151            set bool $_settings($what)
1152            # Only display a outline for the currently visible sets.
1153            SendCmd "outline visible 0"
1154            foreach dataset [CurrentDatasets -visible] {
1155                SendCmd "outline visible $bool $dataset"
1156            }
1157        }
1158        "-polydataopacity" {
1159            set _settings($what) [expr $_widget($what) * 0.01]
1160            EventuallySetPolydataOpacity
1161        }
1162        "-polydatawireframe" {
1163            set bool $_settings($what)
1164            SendCmd "polydata wireframe $bool"
1165        }
1166        "-polydatavisible" {
1167            set bool $_settings($what)
1168            # Only change visibility of data sets marked "visible".
1169            foreach dataset [CurrentDatasets -visible] {
1170                SendCmd "polydata visible $bool $dataset"
1171            }
1172        }
1173        "-polydatalighting" {
1174            set bool $_settings($what)
1175            SendCmd "polydata lighting $bool"
1176        }
1177        "-polydataedges" {
1178            set bool $_settings($what)
1179            SendCmd "polydata edges $bool"
1180        }
1181        "-axesvisible" {
1182            set bool $_settings($what)
1183            SendCmd "axis visible all $bool"
1184        }
1185        "-axislabels" {
1186            set bool $_settings($what)
1187            SendCmd "axis labels all $bool"
1188        }
1189        "-axisminorticks" {
1190            set bool $_settings($what)
1191            SendCmd "axis minticks all $bool"
1192        }
1193        "-xgrid" {
1194            set bool $_settings($what)
1195            SendCmd "axis grid x $bool"
1196        }
1197        "-ygrid" {
1198            set bool $_settings($what)
1199            SendCmd "axis grid y $bool"
1200        }
1201        "-zgrid" {
1202            set bool $_settings($what)
1203            SendCmd "axis grid z $bool"
1204        }
1205        "-axismode" {
1206            set mode [$itk_component(axismode) value]
1207            set mode [$itk_component(axismode) translate $mode]
1208            SendCmd "axis flymode $mode"
1209        }
1210        default {
1211            error "don't know how to fix $what"
1212        }
1213    }
1214}
1215
1216# ----------------------------------------------------------------------
1217# CONFIGURATION OPTION: -plotbackground
1218# ----------------------------------------------------------------------
1219itcl::configbody Rappture::VtkMeshViewer::plotbackground {
1220    if { [isconnected] } {
1221        set rgb [Color2RGB $itk_option(-plotbackground)]
1222        SendCmd "screen bgcolor $rgb"
1223    }
1224}
1225
1226# ----------------------------------------------------------------------
1227# CONFIGURATION OPTION: -plotforeground
1228# ----------------------------------------------------------------------
1229itcl::configbody Rappture::VtkMeshViewer::plotforeground {
1230    if { [isconnected] } {
1231        set rgb [Color2RGB $itk_option(-plotforeground)]
1232        SendCmd "axis color all $rgb"
1233        SendCmd "outline color $rgb"
1234    }
1235}
1236
1237itcl::body Rappture::VtkMeshViewer::limits { dataobj } {
1238    set tag $dataobj
1239    if { ![info exists _limits($tag)] } {
1240        set data [$dataobj vtkdata -full]
1241        if { $data == "" } {
1242            continue
1243        }
1244        set tmpfile file[pid].vtk
1245        set f [open "$tmpfile" "w"]
1246        fconfigure $f -translation binary -encoding binary
1247        puts $f $data
1248        close $f
1249        set reader [vtkDataSetReader $tag-xvtkDataSetReader]
1250        $reader SetFileName $tmpfile
1251        $reader Update
1252        file delete $tmpfile
1253        set output [$reader GetOutput]
1254        set _limits($tag) [$output GetBounds]
1255        rename $output ""
1256        rename $reader ""
1257    }
1258    foreach { xMin xMax yMin yMax zMin zMax} $_limits($tag) break
1259    if {![info exists limits(xmin)] || $limits(xmin) > $xMin} {
1260        set limits(xmin) $xMin
1261    }
1262    if {![info exists limits(xmax)] || $limits(xmax) < $xMax} {
1263        set limits(xmax) $xMax
1264    }
1265    if {![info exists limits(ymin)] || $limits(ymin) > $yMin} {
1266        set limits(ymin) $xMin
1267    }
1268    if {![info exists limits(ymax)] || $limits(ymax) < $yMax} {
1269        set limits(ymax) $yMax
1270    }
1271    if {![info exists limits(zmin)] || $limits(zmin) > $zMin} {
1272        set limits(zmin) $zMin
1273    }
1274    if {![info exists limits(zmax)] || $limits(zmax) < $zMax} {
1275        set limits(zmax) $zMax
1276    }
1277
1278    return [array get limits]
1279}
1280
1281itcl::body Rappture::VtkMeshViewer::BuildPolydataTab {} {
1282
1283    set fg [option get $itk_component(hull) font Font]
1284    #set bfg [option get $itk_component(hull) boldFont Font]
1285
1286    set inner [$itk_component(main) insert end \
1287        -title "Mesh Settings" \
1288        -icon [Rappture::icon mesh]]
1289    $inner configure -borderwidth 4
1290
1291    checkbutton $inner.mesh \
1292        -text "Show Mesh" \
1293        -variable [itcl::scope _settings(-polydatavisible)] \
1294        -command [itcl::code $this AdjustSetting -polydatavisible] \
1295        -font "Arial 9" -anchor w
1296
1297    checkbutton $inner.outline \
1298        -text "Show Outline" \
1299        -variable [itcl::scope _settings(-outline)] \
1300        -command [itcl::code $this AdjustSetting -outline] \
1301        -font "Arial 9" -anchor w
1302
1303    checkbutton $inner.wireframe \
1304        -text "Show Wireframe" \
1305        -variable [itcl::scope _settings(-polydatawireframe)] \
1306        -command [itcl::code $this AdjustSetting -polydatawireframe] \
1307        -font "Arial 9" -anchor w
1308
1309    checkbutton $inner.lighting \
1310        -text "Enable Lighting" \
1311        -variable [itcl::scope _settings(-polydatalighting)] \
1312        -command [itcl::code $this AdjustSetting -polydatalighting] \
1313        -font "Arial 9" -anchor w
1314
1315    checkbutton $inner.edges \
1316        -text "Show Edges" \
1317        -variable [itcl::scope _settings(-polydataedges)] \
1318        -command [itcl::code $this AdjustSetting -polydataedges] \
1319        -font "Arial 9" -anchor w
1320
1321    itk_component add field_l {
1322        label $inner.field_l -text "Field" -font "Arial 9"
1323    } {
1324        ignore -font
1325    }
1326    itk_component add field {
1327        Rappture::Combobox $inner.field -width 10 -editable no
1328    }
1329    bind $inner.field <<Value>> \
1330        [itcl::code $this AdjustSetting -field]
1331
1332    label $inner.opacity_l -text "Opacity" -font "Arial 9" -anchor w
1333    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1334        -variable [itcl::scope _widget(-polydataopacity)] \
1335        -width 10 \
1336        -showvalue off \
1337        -command [itcl::code $this AdjustSetting -polydataopacity]
1338    $inner.opacity set [expr $_settings(-polydataopacity) * 100.0]
1339
1340    blt::table $inner \
1341        0,0 $inner.mesh      -cspan 2  -anchor w -pady 2 \
1342        1,0 $inner.outline   -cspan 2  -anchor w -pady 2 \
1343        2,0 $inner.wireframe -cspan 2  -anchor w -pady 2 \
1344        3,0 $inner.lighting  -cspan 2  -anchor w -pady 2 \
1345        4,0 $inner.edges     -cspan 2  -anchor w -pady 2 \
1346        5,0 $inner.opacity_l -anchor w -pady 2 \
1347        5,1 $inner.opacity   -fill x   -pady 2
1348
1349    blt::table configure $inner r* c* -resize none
1350    blt::table configure $inner r7 c1 -resize expand
1351}
1352
1353itcl::body Rappture::VtkMeshViewer::BuildAxisTab {} {
1354
1355    set fg [option get $itk_component(hull) font Font]
1356    #set bfg [option get $itk_component(hull) boldFont Font]
1357
1358    set inner [$itk_component(main) insert end \
1359        -title "Axis Settings" \
1360        -icon [Rappture::icon axis2]]
1361    $inner configure -borderwidth 4
1362
1363    checkbutton $inner.visible \
1364        -text "Axes" \
1365        -variable [itcl::scope _settings(-axesvisible)] \
1366        -command [itcl::code $this AdjustSetting -axesvisible] \
1367        -font "Arial 9"
1368
1369    checkbutton $inner.labels \
1370        -text "Axis Labels" \
1371        -variable [itcl::scope _settings(-axislabels)] \
1372        -command [itcl::code $this AdjustSetting -axislabels] \
1373        -font "Arial 9"
1374    label $inner.grid_l -text "Grid" -font "Arial 9"
1375    checkbutton $inner.xgrid \
1376        -text "X" \
1377        -variable [itcl::scope _settings(-xgrid)] \
1378        -command [itcl::code $this AdjustSetting -xgrid] \
1379        -font "Arial 9"
1380    checkbutton $inner.ygrid \
1381        -text "Y" \
1382        -variable [itcl::scope _settings(-ygrid)] \
1383        -command [itcl::code $this AdjustSetting -ygrid] \
1384        -font "Arial 9"
1385    checkbutton $inner.zgrid \
1386        -text "Z" \
1387        -variable [itcl::scope _settings(-zgrid)] \
1388        -command [itcl::code $this AdjustSetting -zgrid] \
1389        -font "Arial 9"
1390    checkbutton $inner.minorticks \
1391        -text "Minor Ticks" \
1392        -variable [itcl::scope _settings(-axisminorticks)] \
1393        -command [itcl::code $this AdjustSetting -axisminorticks] \
1394        -font "Arial 9"
1395
1396    label $inner.mode_l -text "Mode" -font "Arial 9"
1397
1398    itk_component add axismode {
1399        Rappture::Combobox $inner.mode -width 10 -editable no
1400    }
1401    $inner.mode choices insert end \
1402        "static_triad"    "static" \
1403        "closest_triad"   "closest" \
1404        "furthest_triad"  "farthest" \
1405        "outer_edges"     "outer"
1406    $itk_component(axismode) value "static"
1407    bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axismode]
1408
1409    blt::table $inner \
1410        0,0 $inner.visible -anchor w -cspan 4 \
1411        1,0 $inner.labels  -anchor w -cspan 4 \
1412        2,0 $inner.minorticks  -anchor w -cspan 4 \
1413        4,0 $inner.grid_l  -anchor w \
1414        4,1 $inner.xgrid   -anchor w \
1415        4,2 $inner.ygrid   -anchor w \
1416        4,3 $inner.zgrid   -anchor w \
1417        5,0 $inner.mode_l  -anchor w -padx { 2 0 } \
1418        5,1 $inner.mode    -fill x   -cspan 3
1419
1420    blt::table configure $inner r* c* -resize none
1421    blt::table configure $inner r7 c6 -resize expand
1422    blt::table configure $inner r3 -height 0.125i
1423}
1424
1425itcl::body Rappture::VtkMeshViewer::BuildCameraTab {} {
1426    set inner [$itk_component(main) insert end \
1427        -title "Camera Settings" \
1428        -icon [Rappture::icon camera]]
1429    $inner configure -borderwidth 4
1430
1431    label $inner.view_l -text "view" -font "Arial 9"
1432    set f [frame $inner.view]
1433    foreach side { front back left right top bottom } {
1434        button $f.$side  -image [Rappture::icon view$side] \
1435            -command [itcl::code $this SetOrientation $side]
1436        Rappture::Tooltip::for $f.$side "Change the view to $side"
1437        pack $f.$side -side left
1438    }
1439
1440    blt::table $inner \
1441        0,0 $inner.view_l -anchor e -pady 2 \
1442        0,1 $inner.view -anchor w -pady 2
1443    blt::table configure $inner r0 -resize none
1444
1445    set labels { qx qy qz qw xpan ypan zoom }
1446    set row 1
1447    foreach tag $labels {
1448        label $inner.${tag}label -text $tag -font "Arial 9"
1449        entry $inner.${tag} -font "Arial 9"  -bg white \
1450            -textvariable [itcl::scope _view(-$tag)]
1451        bind $inner.${tag} <Return> \
1452            [itcl::code $this camera set -${tag}]
1453        bind $inner.${tag} <KP_Enter> \
1454            [itcl::code $this camera set -${tag}]
1455        blt::table $inner \
1456            $row,0 $inner.${tag}label -anchor e -pady 2 \
1457            $row,1 $inner.${tag} -anchor w -pady 2
1458        blt::table configure $inner r$row -resize none
1459        incr row
1460    }
1461    checkbutton $inner.ortho \
1462        -text "Orthographic Projection" \
1463        -variable [itcl::scope _view(-ortho)] \
1464        -command [itcl::code $this camera set -ortho] \
1465        -font "Arial 9"
1466    blt::table $inner \
1467            $row,0 $inner.ortho -cspan 2 -anchor w -pady 2
1468    blt::table configure $inner r$row -resize none
1469    incr row
1470
1471    blt::table configure $inner c* -resize none
1472    blt::table configure $inner c2 -resize expand
1473    blt::table configure $inner r$row -resize expand
1474}
1475
1476#
1477#  camera --
1478#
1479itcl::body Rappture::VtkMeshViewer::camera {option args} {
1480    switch -- $option {
1481        "show" {
1482            puts [array get _view]
1483        }
1484        "set" {
1485            set what [lindex $args 0]
1486            set x $_view($what)
1487            set code [catch { string is double $x } result]
1488            if { $code != 0 || !$result } {
1489                return
1490            }
1491            switch -- $what {
1492                "-ortho" {
1493                    if {$_view($what)} {
1494                        SendCmd "camera mode ortho"
1495                    } else {
1496                        SendCmd "camera mode persp"
1497                    }
1498                }
1499                "-xpan" - "-ypan" {
1500                    PanCamera
1501                }
1502                "-qx" - "-qy" - "-qz" - "-qw" {
1503                    set q [ViewToQuaternion]
1504                    $_arcball quaternion $q
1505                    EventuallyRotate $q
1506                }
1507                "-zoom" {
1508                    SendCmd "camera zoom $_view($what)"
1509                }
1510            }
1511        }
1512    }
1513}
1514
1515itcl::body Rappture::VtkMeshViewer::GetVtkData { args } {
1516    set bytes ""
1517    foreach dataobj [get] {
1518        set contents [$dataobj vtkdata -full]
1519        append bytes "$contents\n"
1520    }
1521    return [list .vtk $bytes]
1522}
1523
1524itcl::body Rappture::VtkMeshViewer::GetImage { args } {
1525    if { [image width $_image(download)] > 0 &&
1526         [image height $_image(download)] > 0 } {
1527        set bytes [$_image(download) data -format "jpeg -quality 100"]
1528        set bytes [Rappture::encoding::decode -as b64 $bytes]
1529        return [list .jpg $bytes]
1530    }
1531    return ""
1532}
1533
1534itcl::body Rappture::VtkMeshViewer::BuildDownloadPopup { popup command } {
1535    Rappture::Balloon $popup \
1536        -title "[Rappture::filexfer::label downloadWord] as..."
1537    set inner [$popup component inner]
1538    label $inner.summary -text "" -anchor w
1539    radiobutton $inner.vtk_button -text "VTK data file" \
1540        -variable [itcl::scope _downloadPopup(format)] \
1541        -font "Helvetica 9 " \
1542        -value vtk
1543    Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
1544    radiobutton $inner.image_button -text "Image File" \
1545        -variable [itcl::scope _downloadPopup(format)] \
1546        -value image
1547    Rappture::Tooltip::for $inner.image_button \
1548        "Save as digital image."
1549
1550    button $inner.ok -text "Save" \
1551        -highlightthickness 0 -pady 2 -padx 3 \
1552        -command $command \
1553        -compound left \
1554        -image [Rappture::icon download]
1555
1556    button $inner.cancel -text "Cancel" \
1557        -highlightthickness 0 -pady 2 -padx 3 \
1558        -command [list $popup deactivate] \
1559        -compound left \
1560        -image [Rappture::icon cancel]
1561
1562    blt::table $inner \
1563        0,0 $inner.summary -cspan 2  \
1564        1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
1565        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
1566        4,1 $inner.cancel -width .9i -fill y \
1567        4,0 $inner.ok -padx 2 -width .9i -fill y
1568    blt::table configure $inner r3 -height 4
1569    blt::table configure $inner r4 -pady 4
1570    raise $inner.image_button
1571    $inner.vtk_button invoke
1572    return $inner
1573}
1574
1575itcl::body Rappture::VtkMeshViewer::SetObjectStyle { dataobj } {
1576    # Parse style string.
1577    set tag $dataobj
1578    set type [$dataobj type]
1579
1580    array set style {
1581        -cloudstyle mesh
1582        -color white
1583        -edgecolor black
1584        -edges 1
1585        -lighting 1
1586        -linewidth 1.0
1587        -opacity 1.0
1588        -outline 0
1589        -visible 1
1590        -wireframe 0
1591    }
1592    if { $dataobj != $_first } {
1593        set style(-wireframe) 1
1594    }
1595    if {$type == "cloud"} {
1596        set style(-cloudstyle) points
1597        set style(-edges) 0
1598        set style(-edgecolor) white
1599    }
1600    array set style [$dataobj hints style]
1601
1602    if {[$dataobj hints color] != ""} {
1603        set style(-color) [$dataobj hints color]
1604    }
1605    SendCmd "outline add $tag"
1606    SendCmd "outline color [Color2RGB $style(-color)] $tag"
1607    SendCmd "outline visible $style(-outline) $tag"
1608    set _settings(-outline) $style(-outline)
1609
1610    SendCmd "polydata add $tag"
1611    SendCmd "polydata visible $style(-visible) $tag"
1612    set _settings(-polydatavisible) $style(-visible)
1613    SendCmd "polydata cloudstyle $style(-cloudstyle) $tag"
1614    SendCmd "polydata edges $style(-edges) $tag"
1615    set _settings(-polydataedges) $style(-edges)
1616    SendCmd "polydata color [Color2RGB $style(-color)] $tag"
1617    SendCmd "polydata lighting $style(-lighting) $tag"
1618    set _settings(-polydatalighting) $style(-lighting)
1619    SendCmd "polydata linecolor [Color2RGB $style(-edgecolor)] $tag"
1620    SendCmd "polydata linewidth $style(-linewidth) $tag"
1621    SendCmd "polydata opacity $style(-opacity) $tag"
1622    set _settings(-polydataopacity) $style(-opacity)
1623    set _widget(-polydataopacity) [expr 100.0 * $style(-opacity)]
1624    SendCmd "polydata wireframe $style(-wireframe) $tag"
1625    set _settings(-polydatawireframe) $style(-wireframe)
1626    set havePolyData 1
1627}
1628
1629itcl::body Rappture::VtkMeshViewer::IsValidObject { dataobj } {
1630    if {[catch {$dataobj isa Rappture::Mesh} valid] != 0 || !$valid} {
1631        return 0
1632    }
1633    return 1
1634}
1635
1636itcl::body Rappture::VtkMeshViewer::SetOrientation { side } {
1637    array set positions {
1638        front "1 0 0 0"
1639        back  "0 0 1 0"
1640        left  "0.707107 0 -0.707107 0"
1641        right "0.707107 0 0.707107 0"
1642        top   "0.707107 -0.707107 0 0"
1643        bottom "0.707107 0.707107 0 0"
1644    }
1645    foreach name { -qw -qx -qy -qz } value $positions($side) {
1646        set _view($name) $value
1647    }
1648    set q [ViewToQuaternion]
1649    $_arcball quaternion $q
1650    SendCmd "camera orient $q"
1651    SendCmd "camera reset"
1652    set _view(-xpan) 0
1653    set _view(-ypan) 0
1654    set _view(-zoom) 1.0
1655}
Note: See TracBrowser for help on using the repository browser.