# -*- mode: tcl; indent-tabs-mode: nil -*- # ---------------------------------------------------------------------- # COMPONENT: flowvisviewer - 3D flow rendering # # This widget performs volume and flow rendering on 3D scalar/vector datasets. # It connects to the Flowvis server running on a rendering farm, transmits # data, and displays the results. # # ====================================================================== # AUTHOR: Michael McLennan, Purdue University # Copyright (c) 2004-2012 HUBzero Foundation, LLC # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # ====================================================================== package require Itk package require BLT package require Img option add *FlowvisViewer.width 5i widgetDefault option add *FlowvisViewer*cursor crosshair widgetDefault option add *FlowvisViewer.height 4i widgetDefault option add *FlowvisViewer.foreground black widgetDefault option add *FlowvisViewer.controlBackground gray widgetDefault option add *FlowvisViewer.controlDarkBackground #999999 widgetDefault option add *FlowvisViewer.plotBackground black widgetDefault option add *FlowvisViewer.plotForeground white widgetDefault option add *FlowvisViewer.plotOutline gray widgetDefault option add *FlowvisViewer.font \ -*-helvetica-medium-r-normal-*-12-* widgetDefault # must use this name -- plugs into Rappture::resources::load proc FlowvisViewer_init_resources {} { Rappture::resources::register \ nanovis_server Rappture::FlowvisViewer::SetServerList } itcl::class Rappture::FlowvisViewer { inherit Rappture::VisViewer itk_option define -plotforeground plotForeground Foreground "" itk_option define -plotbackground plotBackground Background "" itk_option define -plotoutline plotOutline PlotOutline "" constructor { hostlist args } { Rappture::VisViewer::constructor $hostlist } { # defined below } destructor { # defined below } public proc SetServerList { namelist } { Rappture::VisViewer::SetServerList "nanovis" $namelist } public method add {dataobj {settings ""}} public method camera {option args} public method delete {args} public method disconnect {} public method download {option args} public method flow {option} public method get {args} public method isconnected {} public method limits { cname } public method overMarker { m x } public method parameters {title args} { # do nothing } public method removeDuplicateMarker { m x } public method scale {args} public method updateTransferFunctions {} # soon to be removed. private method Flow {option args} private method Play {} private method Pause {} # The following methods are only used by this class. private method AdjustSetting {what {value ""}} private method AddIsoMarker { x y } private method BuildCameraTab {} private method BuildCutplanesTab {} private method BuildViewTab {} private method BuildVolumeComponents {} private method BuildVolumeTab {} private method ComputeTransferFunc { tf } private method Connect {} private method CurrentVolumeIds {{what -all}} private method Disconnect {} private method EventuallyResize { w h } private method EventuallyGoto { nSteps } private method EventuallyResizeLegend { } private method GetDatasetsWithComponent { cname } private method GetFlowInfo { widget } private method GetMovie { widget width height } private method GetPngImage { widget width height } private method InitSettings { args } private method NameTransferFunc { dataobj comp } private method Pan {option x y} private method PanCamera {} private method ParseLevelsOption { tf levels } private method ParseMarkersOption { tf markers } private method QuaternionToView { q } { foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break } private method Rebuild {} private method ReceiveData { args } private method ReceiveImage { args } private method ReceiveLegend { tf vmin vmax size } private method Resize {} private method ResizeLegend {} private method Rotate {option x y} private method SendFlowCmd { dataobj comp nbytes extents } private method SendTransferFuncs {} private method SetOrientation { side } private method Slice {option args} private method SlicerTip {axis} private method ViewToQuaternion {} { return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)] } private method WaitIcon { option widget } private method Zoom {option} private method arrows { tag name } private method box { tag name } private method millisecs2str { value } private method particles { tag name } private method str2millisecs { value } private method streams { tag name } private variable _arcball "" private variable _dlist "" ;# list of data objects private variable _allDataObjs private variable _obj2ovride ;# maps dataobj => style override private variable _serverObjs ;# maps dataobj-component to volume ID # in the server private variable _recvObjs ;# list of data objs to send to server private variable _obj2style ;# maps dataobj-component to transfunc private variable _style2objs ;# maps tf back to list of # dataobj-components using the tf. private variable _obj2flow; # Maps dataobj-component to a flow. private variable _reset 1 ;# Connection to server has been reset private variable _click ;# info used for rotate operations private variable _limits ;# autoscale min/max for all axes private variable _view ;# view params for 3D view private variable _isomarkers ;# array of isosurface level values 0..1 private common _settings private variable _activeTf "" ;# The currently active transfer function. private variable _first "" ;# This is the topmost volume. private variable _volcomponents ;# Array of components found private variable _componentsList ;# Array of components found private variable _nextToken 0 private variable _icon 0 private variable _flow private common _downloadPopup ;# download options from popup private common _hardcopy private variable _width 0 private variable _height 0 private variable _resizePending 0 private variable _resizeLegendPending 0 private variable _gotoPending 0 } itk::usual FlowvisViewer { keep -background -foreground -cursor -font keep -plotbackground -plotforeground } # ---------------------------------------------------------------------- # CONSTRUCTOR # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::constructor { hostlist args } { set _serverType "nanovis" # Draw legend event $_dispatcher register !legend $_dispatcher dispatch $this !legend "[itcl::code $this ResizeLegend]; list" # Send transferfunctions event $_dispatcher register !send_transfunc $_dispatcher dispatch $this !send_transfunc \ "[itcl::code $this SendTransferFuncs]; list" # Rebuild event. $_dispatcher register !rebuild $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list" # Resize event. $_dispatcher register !resize $_dispatcher dispatch $this !resize "[itcl::code $this Resize]; list" $_dispatcher register !play $_dispatcher dispatch $this !play "[itcl::code $this flow next]; list" # Draw legend event $_dispatcher register !goto $_dispatcher dispatch $this !goto "[itcl::code $this flow goto2]; list" $_dispatcher register !movietimeout $_dispatcher register !waiticon set _flow(state) 0 array set _downloadPopup { format draft } # # Populate parser with commands handle incoming requests # $_parser alias image [itcl::code $this ReceiveImage] $_parser alias legend [itcl::code $this ReceiveLegend] $_parser alias data [itcl::code $this ReceiveData] # Initialize the view to some default parameters. array set _view { -qw 0.853553 -qx -0.353553 -qy 0.353553 -qz 0.146447 -xpan 0 -ypan 0 -zoom 1.0 } set _arcball [blt::arcball create 100 100] $_arcball quaternion [ViewToQuaternion] set _limits(v) [list 0.0 1.0] set _reset 1 array set _settings [subst { $this-qw $_view(-qw) $this-qx $_view(-qx) $this-qy $_view(-qy) $this-qz $_view(-qz) $this-zoom $_view(-zoom) $this-xpan $_view(-xpan) $this-ypan $_view(-ypan) $this-arrows 0 $this-currenttime 0 $this-duration 1:00 $this-loop 0 $this-play 0 $this-speed 500 $this-step 0 $this-streams 0 $this-volume 1 $this-ambient 60 $this-diffuse 40 $this-light2side 1 $this-opacity 50 $this-specularLevel 30 $this-specularExponent 90 $this-thickness 350 $this-cutplaneVisible 0 $this-xcutplane 1 $this-xcutposition 0 $this-ycutplane 1 $this-ycutposition 0 $this-zcutplane 1 $this-zcutposition 0 }] itk_component add 3dview { label $itk_component(plotarea).view -image $_image(plot) \ -highlightthickness 0 -borderwidth 0 } { usual ignore -highlightthickness -borderwidth -background } bind $itk_component(3dview) [itcl::code $this ToggleConsole] set f [$itk_component(main) component controls] itk_component add reset { button $f.reset -borderwidth 1 -padx 1 -pady 1 \ -highlightthickness 0 \ -image [Rappture::icon reset-view] \ -command [itcl::code $this Zoom reset] } { usual ignore -highlightthickness } pack $itk_component(reset) -side top -padx 2 -pady 2 Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level" itk_component add zoomin { button $f.zin -borderwidth 1 -padx 1 -pady 1 \ -highlightthickness 0 \ -image [Rappture::icon zoom-in] \ -command [itcl::code $this Zoom in] } { usual ignore -highlightthickness } pack $itk_component(zoomin) -side top -padx 2 -pady 2 Rappture::Tooltip::for $itk_component(zoomin) "Zoom in" itk_component add zoomout { button $f.zout -borderwidth 1 -padx 1 -pady 1 \ -highlightthickness 0 \ -image [Rappture::icon zoom-out] \ -command [itcl::code $this Zoom out] } { usual ignore -highlightthickness } pack $itk_component(zoomout) -side top -padx 2 -pady 2 Rappture::Tooltip::for $itk_component(zoomout) "Zoom out" itk_component add volume { Rappture::PushButton $f.volume \ -onimage [Rappture::icon volume-on] \ -offimage [Rappture::icon volume-off] \ -command [itcl::code $this AdjustSetting volume] \ -variable [itcl::scope _settings($this-volume)] } $itk_component(volume) select Rappture::Tooltip::for $itk_component(volume) \ "Toggle the volume cloud on/off" pack $itk_component(volume) -padx 2 -pady 2 itk_component add cutplane { Rappture::PushButton $f.cutplane \ -onimage [Rappture::icon cutbutton] \ -offimage [Rappture::icon cutbutton] \ -variable [itcl::scope _settings($this-cutplaneVisible)] \ -command [itcl::code $this AdjustSetting cutplaneVisible] } Rappture::Tooltip::for $itk_component(cutplane) \ "Show/Hide cutplanes" pack $itk_component(cutplane) -padx 2 -pady 2 if { [catch { BuildViewTab BuildVolumeTab BuildCutplanesTab BuildCameraTab } errs] != 0 } { global errorInfo puts stderr "errs=$errs errorInfo=$errorInfo" } bind $itk_component(3dview) \ [itcl::code $this EventuallyResize %w %h] # Legend set _image(legend) [image create photo] itk_component add legend { canvas $itk_component(plotarea).legend -height 50 -highlightthickness 0 } { usual ignore -highlightthickness rename -background -plotbackground plotBackground Background } bind $itk_component(legend) \ [itcl::code $this EventuallyResizeLegend] # Hack around the Tk panewindow. The problem is that the requested # size of the 3d view isn't set until an image is retrieved from # the server. So the panewindow uses the tiny size. set w 10000 pack forget $itk_component(3dview) blt::table $itk_component(plotarea) \ 0,0 $itk_component(3dview) -fill both -reqwidth $w \ 1,0 $itk_component(legend) -fill x blt::table configure $itk_component(plotarea) r1 -resize none # Create flow controls... itk_component add flowcontrols { frame $itk_interior.flowcontrols } { usual rename -background -controlbackground controlBackground Background } pack forget $itk_component(main) blt::table $itk_interior \ 0,0 $itk_component(main) -fill both \ 1,0 $itk_component(flowcontrols) -fill x blt::table configure $itk_interior r1 -resize none # Rewind itk_component add rewind { button $itk_component(flowcontrols).reset \ -borderwidth 1 -padx 1 -pady 1 \ -image [Rappture::icon flow-rewind] \ -command [itcl::code $this flow reset] } { usual ignore -borderwidth rename -highlightbackground -controlbackground controlBackground \ Background } Rappture::Tooltip::for $itk_component(rewind) \ "Rewind flow" # Stop itk_component add stop { button $itk_component(flowcontrols).stop \ -borderwidth 1 -padx 1 -pady 1 \ -image [Rappture::icon flow-stop] \ -command [itcl::code $this flow stop] } { usual ignore -borderwidth rename -highlightbackground -controlbackground controlBackground \ Background } Rappture::Tooltip::for $itk_component(stop) \ "Stop flow" # Play itk_component add play { Rappture::PushButton $itk_component(flowcontrols).play \ -onimage [Rappture::icon flow-pause] \ -offimage [Rappture::icon flow-play] \ -variable [itcl::scope _settings($this-play)] \ -command [itcl::code $this flow toggle] } set fg [option get $itk_component(hull) font Font] Rappture::Tooltip::for $itk_component(play) \ "Play/Pause flow" # Loop itk_component add loop { Rappture::PushButton $itk_component(flowcontrols).loop \ -onimage [Rappture::icon flow-loop] \ -offimage [Rappture::icon flow-loop] \ -variable [itcl::scope _settings($this-loop)] } Rappture::Tooltip::for $itk_component(loop) \ "Play continuously" itk_component add dial { Rappture::Flowdial $itk_component(flowcontrols).dial \ -length 10 -valuewidth 0 -valuepadding 0 -padding 6 \ -linecolor "" -activelinecolor "" \ -min 0.0 -max 1.0 \ -variable [itcl::scope _settings($this-currenttime)] \ -knobimage [Rappture::icon knob2] -knobposition center@middle } { usual ignore -dialprogresscolor rename -background -controlbackground controlBackground Background } $itk_component(dial) current 0.0 bind $itk_component(dial) <> [itcl::code $this flow goto] # Duration itk_component add duration { entry $itk_component(flowcontrols).duration \ -textvariable [itcl::scope _settings($this-duration)] \ -bg white -width 6 -font "arial 9" } { usual ignore -highlightthickness -background } bind $itk_component(duration) [itcl::code $this flow duration] bind $itk_component(duration) [itcl::code $this flow duration] bind $itk_component(duration) [itcl::code $this flow duration] Rappture::Tooltip::for $itk_component(duration) \ "Set duration of flow (format is min:sec)" itk_component add durationlabel { label $itk_component(flowcontrols).durationl \ -text "Duration:" -font $fg \ -highlightthickness 0 } { usual ignore -highlightthickness rename -background -controlbackground controlBackground Background } itk_component add speedlabel { label $itk_component(flowcontrols).speedl -text "Speed:" -font $fg \ -highlightthickness 0 } { usual ignore -highlightthickness rename -background -controlbackground controlBackground Background } # Speed itk_component add speed { Rappture::Flowspeed $itk_component(flowcontrols).speed \ -min 1 -max 10 -width 3 -font "arial 9" } { usual ignore -highlightthickness rename -background -controlbackground controlBackground Background } Rappture::Tooltip::for $itk_component(speed) \ "Change speed of flow" $itk_component(speed) value 1 bind $itk_component(speed) <> [itcl::code $this flow speed] blt::table $itk_component(flowcontrols) \ 0,0 $itk_component(rewind) -padx {3 0} \ 0,1 $itk_component(stop) -padx {2 0} \ 0,2 $itk_component(play) -padx {2 0} \ 0,3 $itk_component(loop) -padx {2 0} \ 0,4 $itk_component(dial) -fill x -padx {2 0 } \ 0,5 $itk_component(duration) -padx { 0 0} \ 0,7 $itk_component(speed) -padx {2 3} # 0,6 $itk_component(speedlabel) -padx {2 0} blt::table configure $itk_component(flowcontrols) c* -resize none blt::table configure $itk_component(flowcontrols) c4 -resize both blt::table configure $itk_component(flowcontrols) r0 -pady 1 # Bindings for rotation via mouse bind $itk_component(3dview) \ [itcl::code $this Rotate click %x %y] bind $itk_component(3dview) \ [itcl::code $this Rotate drag %x %y] bind $itk_component(3dview) \ [itcl::code $this Rotate release %x %y] bind $itk_component(3dview) \ [itcl::code $this EventuallyResize %w %h] # Bindings for panning via mouse bind $itk_component(3dview) \ [itcl::code $this Pan click %x %y] bind $itk_component(3dview) \ [itcl::code $this Pan drag %x %y] bind $itk_component(3dview) \ [itcl::code $this Pan release %x %y] # Bindings for panning via keyboard bind $itk_component(3dview) \ [itcl::code $this Pan set -10 0] bind $itk_component(3dview) \ [itcl::code $this Pan set 10 0] bind $itk_component(3dview) \ [itcl::code $this Pan set 0 -10] bind $itk_component(3dview) \ [itcl::code $this Pan set 0 10] bind $itk_component(3dview) \ [itcl::code $this Pan set -2 0] bind $itk_component(3dview) \ [itcl::code $this Pan set 2 0] bind $itk_component(3dview) \ [itcl::code $this Pan set 0 -2] bind $itk_component(3dview) \ [itcl::code $this Pan set 0 2] # Bindings for zoom via keyboard bind $itk_component(3dview) \ [itcl::code $this Zoom out] bind $itk_component(3dview) \ [itcl::code $this Zoom in] bind $itk_component(3dview) "focus $itk_component(3dview)" if {[string equal "x11" [tk windowingsystem]]} { # Bindings for zoom via mouse bind $itk_component(3dview) <4> [itcl::code $this Zoom out] bind $itk_component(3dview) <5> [itcl::code $this Zoom in] } set _image(download) [image create photo] eval itk_initialize $args EnableWaitDialog 900 Connect } # ---------------------------------------------------------------------- # DESTRUCTOR # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::destructor {} { $_dispatcher cancel !rebuild $_dispatcher cancel !send_transfunc image delete $_image(plot) image delete $_image(legend) image delete $_image(download) catch { blt::arcball destroy $_arcball } array unset _settings $this-* } # ---------------------------------------------------------------------- # USAGE: add ?? # # Clients use this to add a data object to the plot. The optional # are used to configure the plot. Allowed settings are # -color, -brightness, -width, -linestyle, and -raise. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::add {dataobj {settings ""}} { array set params { -color auto -width 1 -linestyle solid -brightness 0 -raise 0 -description "" -param "" } array set params $settings if {$params(-color) == "auto" || $params(-color) == "autoreset"} { # can't handle -autocolors yet set params(-color) black } foreach comp [$dataobj components] { set flowobj [$dataobj flowhints $comp] if { $flowobj == "" } { puts stderr "no flowhints $dataobj-$comp" continue } set _obj2flow($dataobj-$comp) $flowobj } set pos [lsearch -exact $_dlist $dataobj] if {$pos < 0} { lappend _dlist $dataobj set _allDataObjs($dataobj) 1 set _obj2ovride($dataobj-color) $params(-color) set _obj2ovride($dataobj-width) $params(-width) set _obj2ovride($dataobj-raise) $params(-raise) $_dispatcher event -idle !rebuild } } # ---------------------------------------------------------------------- # USAGE: get ?-objects? # USAGE: get ?-image 3dview|legend? # # Clients use this to query the list of objects being plotted, in # order from bottom to top of this result. The optional "-image" # flag can also request the internal images being shown. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::get {args} { if {[llength $args] == 0} { set args "-objects" } set op [lindex $args 0] switch -- $op { -objects { # put the dataobj list in order according to -raise options set dlist $_dlist foreach obj $dlist { if {[info exists _obj2ovride($obj-raise)] && $_obj2ovride($obj-raise)} { set i [lsearch -exact $dlist $obj] if {$i >= 0} { set dlist [lreplace $dlist $i $i] lappend dlist $obj } } } return $dlist } -image { if {[llength $args] != 2} { error "wrong # args: should be \"get -image 3dview|legend\"" } switch -- [lindex $args end] { 3dview { return $_image(plot) } legend { return $_image(legend) } default { error "bad image name \"[lindex $args end]\": should be 3dview or legend" } } } default { error "bad option \"$op\": should be -objects or -image" } } } # ---------------------------------------------------------------------- # USAGE: delete ? ...? # # Clients use this to delete a dataobj from the plot. If no dataobjs # are specified, then all dataobjs are deleted. No data objects are # deleted. They are only removed from the display list. # # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::delete {args} { flow stop if {[llength $args] == 0} { set args $_dlist } # Delete all specified dataobjs set changed 0 foreach dataobj $args { set pos [lsearch -exact $_dlist $dataobj] if { $pos >= 0 } { foreach comp [$dataobj components] { array unset _limits $dataobj-$comp-* } set _dlist [lreplace $_dlist $pos $pos] array unset _obj2ovride $dataobj-* array unset _obj2flow $dataobj-* array unset _serverObjs $dataobj-* array unset _obj2style $dataobj-* set changed 1 } } # If anything changed, then rebuild the plot if {$changed} { # Repair the reverse lookup foreach tf [array names _style2objs] { set list {} foreach {dataobj comp} $_style2objs($tf) break if { [info exists _serverObjs($dataobj-$comp)] } { lappend list $dataobj $comp } if { $list == "" } { array unset _style2objs $tf } else { set _style2objs($tf) $list } } $_dispatcher event -idle !rebuild } } # ---------------------------------------------------------------------- # USAGE: scale ? ...? # # Sets the default limits for the overall plot according to the # limits of the data for all of the given objects. This # accounts for all objects--even those not showing on the screen. # Because of this, the limits are appropriate for all objects as # the user scans through data in the ResultSet viewer. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::scale {args} { array set styles { -color BCGYR -levels 6 -markers "" -opacity 0.5 } array unset _limits array unset _volcomponents foreach dataobj $args { if { ![$dataobj isvalid] } { continue; # Object doesn't contain valid data. } foreach cname [$dataobj components] { if { ![info exists _volcomponents($cname)] } { lappend _componentsList $cname array set styles [lindex [$dataobj components -style $cname] 0] set cmap [ColorsToColormap $styles(-color)] set _cname2defaultcolormap($cname) $cmap set _settings($cname-colormap) $styles(-color) } lappend _volcomponents($cname) $dataobj-$cname array unset limits array set limits [$dataobj valueLimits $cname] set _limits($cname) $limits(v) } foreach axis {x y z v} { foreach { min max } [$dataobj limits $axis] break if {"" != $min && "" != $max} { if { ![info exists _limits($axis)] } { set _limits($axis) [list $min $max] continue } foreach {amin amax} $_limits($axis) break if {$min < $amin} { set amin $min } if {$max > $amax} { set amax $max } set _limits($axis) [list $amin $amax] } } } #BuildVolumeComponents } # ---------------------------------------------------------------------- # USAGE: download coming # USAGE: download controls # USAGE: download now # # Clients use this method to create a downloadable representation # of the plot. Returns a list of the form {ext string}, where # "ext" is the file extension (indicating the type of data) and # "string" is the data itself. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::download {option args} { set popup .flowvisviewerdownload switch $option { coming { if {[catch { blt::winop snap $itk_component(plotarea) $_image(download) }]} { $_image(download) configure -width 1 -height 1 $_image(download) put #000000 } } controls { if {![winfo exists $popup]} { # if we haven't created the popup yet, do it now Rappture::Balloon $popup \ -title "[Rappture::filexfer::label downloadWord] as..." set inner [$popup component inner] label $inner.summary -text "" -anchor w pack $inner.summary -side top set img $_image(plot) set res "[image width $img]x[image height $img]" radiobutton $inner.draft -text "Image (draft $res)" \ -variable Rappture::FlowvisViewer::_downloadPopup(format) \ -value draft pack $inner.draft -anchor w set res "640x480" radiobutton $inner.medium -text "Movie (standard $res)" \ -variable Rappture::FlowvisViewer::_downloadPopup(format) \ -value $res pack $inner.medium -anchor w set res "1024x768" radiobutton $inner.high -text "Movie (high quality $res)" \ -variable Rappture::FlowvisViewer::_downloadPopup(format) \ -value $res pack $inner.high -anchor w button $inner.go -text [Rappture::filexfer::label download] \ -command [lindex $args 0] pack $inner.go -pady 4 $inner.draft select } else { set inner [$popup component inner] } set num [llength [get]] set num [expr {($num == 1) ? "1 result" : "$num results"}] set word [Rappture::filexfer::label downloadWord] $inner.summary configure -text "$word $num in the following format:" update idletasks ;# fix initial sizes update return $popup } now { if { [winfo exists $popup] } { $popup deactivate } switch -- $_downloadPopup(format) { draft { # Get the image data (as base64) and decode it back to # binary. This is better than writing to temporary # files. When we switch to the BLT picture image it # won't be necessary to decode the image data. set bytes [$_image(plot) data -format "jpeg -quality 100"] set bytes [Rappture::encoding::decode -as b64 $bytes] return [list .jpg $bytes] } "640x480" { return [$this GetMovie [lindex $args 0] 640 480] } "1024x768" { return [$this GetMovie [lindex $args 0] 1024 768] } default { error "bad download format $_downloadPopup(format)" } } } default { error "bad option \"$option\": should be coming, controls, now" } } } # ---------------------------------------------------------------------- # USAGE: Connect ?,...? # # Clients use this method to establish a connection to a new # server, or to reestablish a connection to the previous server. # Any existing connection is automatically closed. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::Connect {} { set _hosts [GetServerList "nanovis"] if { "" == $_hosts } { return 0 } set _reset 1 set result [VisViewer::Connect $_hosts] if { $result } { if { $_reportClientInfo } { # Tell the server the viewer, hub, user and session. # Do this immediately on connect before buffering any commands global env set info {} set user "???" if { [info exists env(USER)] } { set user $env(USER) } set session "???" if { [info exists env(SESSION)] } { set session $env(SESSION) } lappend info "version" "$Rappture::version" lappend info "build" "$Rappture::build" lappend info "svnurl" "$Rappture::svnurl" lappend info "installdir" "$Rappture::installdir" lappend info "hub" [exec hostname] lappend info "client" "flowvisviewer" lappend info "user" $user lappend info "session" $session SendCmd "clientinfo [list $info]" } set w [winfo width $itk_component(3dview)] set h [winfo height $itk_component(3dview)] EventuallyResize $w $h } return $result } # # isconnected -- # # Indicates if we are currently connected to the visualization server. # itcl::body Rappture::FlowvisViewer::isconnected {} { return [VisViewer::IsConnected] } # # disconnect -- # itcl::body Rappture::FlowvisViewer::disconnect {} { Disconnect } # # Disconnect -- # # Clients use this method to disconnect from the current rendering # server. # itcl::body Rappture::FlowvisViewer::Disconnect {} { VisViewer::Disconnect # disconnected -- no more data sitting on server array unset _serverObjs } # ---------------------------------------------------------------------- # USAGE: SendTransferFuncs # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::SendTransferFuncs {} { if { $_activeTf == "" } { puts stderr "no active tf" return } set tf $_activeTf if { $_first == "" } { puts stderr "no first" return } # Ensure that the global thickness setting (in the slider settings widget) # is used for the active transfer-function. Update the values in the # _settings varible. set value $_settings($this-thickness) # Scale values between 0.00001 and 0.01000 set thickness [expr {double($value) * 0.0001}] set _settings($this-$tf-thickness) $thickness foreach key [array names _obj2style $_first-*] { if { [info exists _obj2style($key)] } { foreach tf $_obj2style($key) { ComputeTransferFunc $tf } } } EventuallyResizeLegend } # ---------------------------------------------------------------------- # USAGE: ReceiveImage -bytes $size -type $type -token $token # # Invoked automatically whenever the "image" command comes in from # the rendering server. Indicates that binary image data with the # specified will follow. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::ReceiveImage { args } { array set info { -token "???" -bytes 0 -type image } array set info $args set bytes [ReceiveBytes $info(-bytes)] ReceiveEcho <" set c $itk_component(legend) set w [winfo width $c] set h [winfo height $c] set lx 10 set ly [expr {$h - 1}] if {"" == [$c find withtag colorbar]} { $c create image 10 10 -anchor nw \ -image $_image(legend) -tags colorbar $c create text $lx $ly -anchor sw \ -fill $itk_option(-plotforeground) -tags "limits vmin" $c create text [expr {$w-$lx}] $ly -anchor se \ -fill $itk_option(-plotforeground) -tags "limits vmax" $c lower colorbar $c bind colorbar [itcl::code $this AddIsoMarker %x %y] } # Display the markers used by the active transfer function. set tf $_obj2style($tag) foreach {vmin vmax} [limits $tf] break $c itemconfigure vmin -text [format %g $vmin] $c coords vmin $lx $ly $c itemconfigure vmax -text [format %g $vmax] $c coords vmax [expr {$w-$lx}] $ly if { [info exists _isomarkers($tf)] } { foreach m $_isomarkers($tf) { $m visible yes } } } # # ReceiveData -- # # The procedure is the response from the render server to each "data # follows" command. The server sends back a "data" command invoked our # the slave interpreter. The purpose is to collect the min/max of the # volume sent to the render server. Since the client (flowvisviewer) # doesn't parse 3D data formats, we rely on the server (flowvis) to # tell us what the limits are. Once we've received the limits to all # the data we've sent (tracked by _recvObjs) we can then determine # what the transfer functions are for these # volumes. # # Note: There is a considerable tradeoff in having the server report # back what the data limits are. It means that much of the code # having to do with transfer-functions has to wait for the data # to come back, since the isomarkers are calculated based upon # the data limits. The client code is much messier because of # this. The alternative is to parse any of the 3D formats on the # client side. # itcl::body Rappture::FlowvisViewer::ReceiveData { args } { if { ![isconnected] } { return } # Arguments from server are name value pairs. Stuff them in an array. array set values $args set tag $values(tag) set parts [split $tag -] set dataobj [lindex $parts 0] set _serverObjs($tag) 0 set _limits($tag) [list $values(min) $values(max)] unset _recvObjs($tag) if { [array size _recvObjs] == 0 } { updateTransferFunctions } } # # Rebuild -- # # Called automatically whenever something changes that affects the data # in the widget. Clears any existing data and rebuilds the widget to # display new data. # itcl::body Rappture::FlowvisViewer::Rebuild {} { set w [winfo width $itk_component(3dview)] set h [winfo height $itk_component(3dview)] if { $w < 2 || $h < 2 } { update $_dispatcher event -idle !rebuild return } # Turn on buffering of commands to the server. We don't want to # be preempted by a server disconnect/reconnect (which automatically # generates a new call to Rebuild). StartBufferingCommands # Hide all the isomarkers. Can't remove them. Have to remember the # settings since the user may have created/deleted/moved markers. foreach tf [array names _isomarkers] { foreach m $_isomarkers($tf) { $m visible no } } if { $_width != $w || $_height != $h || $_reset } { set _width $w set _height $h $_arcball resize $w $h Resize } set _first "" foreach dataobj [get] { foreach comp [$dataobj components] { set tag $dataobj-$comp set isvtk 0 # FIXME: Would like to use the type method of the dataobj # but the returned value isn't well defined now if {[catch { # Send the data as one huge base64-encoded mess -- yuck! set data [$dataobj blob $comp] }]} { set data [$dataobj vtkdata $comp] set isvtk 1 } set nbytes [string length $data] if { $_reportClientInfo } { set info {} lappend info "tool_id" [$dataobj hints toolid] lappend info "tool_name" [$dataobj hints toolname] lappend info "tool_title" [$dataobj hints tooltitle] lappend info "tool_command" [$dataobj hints toolcommand] lappend info "tool_revision" [$dataobj hints toolrevision] lappend info "dataset_label" [$dataobj hints label] lappend info "dataset_size" $nbytes lappend info "dataset_tag" $tag SendCmd "clientinfo [list $info]" } set extents [$dataobj extents $comp] # I have a field. Is a vector field or a volume field? if { !$isvtk && $extents == 1 } { SendCmd "volume data follows $nbytes $tag" } else { if {[SendFlowCmd $dataobj $comp $nbytes $extents] < 0} { continue } } SendData $data NameTransferFunc $dataobj $comp set _recvObjs($tag) 1 } } set _first [lindex [get] 0] foreach axis {x y z} { # Turn off cutplanes for all volumes SendCmd "cutplane state 0 $axis" } # Reset the camera and other view parameters InitSettings light2side ambient diffuse specularLevel specularExponent \ opacity isosurface grid axes volume outline \ cutplaneVisible xcutplane ycutplane zcutplane # nothing to send -- activate the proper volume if {"" != $_first} { set axis [$_first hints updir] if {"" != $axis} { SendCmd "up $axis" } set location [$_first hints camera] if { $location != "" } { array set _view $location } } set _settings($this-qw) $_view(-qw) set _settings($this-qx) $_view(-qx) set _settings($this-qy) $_view(-qy) set _settings($this-qz) $_view(-qz) set _settings($this-xpan) $_view(-xpan) set _settings($this-ypan) $_view(-ypan) set _settings($this-zoom) $_view(-zoom) set q [ViewToQuaternion] $_arcball quaternion $q SendCmd "camera orient $q" SendCmd "camera reset" PanCamera SendCmd "camera zoom $_view(-zoom)" foreach dataobj [get] { foreach comp [$dataobj components] { NameTransferFunc $dataobj $comp } } # nothing to send -- activate the proper ivol set _first [lindex [get] 0] if {"" != $_first} { set axis [$_first hints updir] if {"" != $axis} { SendCmd "up $axis" } set location [$_first hints camera] if { $location != "" } { array set _view $location } set comp [lindex [$_first components] 0] set _activeTf [lindex $_obj2style($_first-$comp) 0] } # sync the state of slicers set vols [CurrentVolumeIds -cutplanes] foreach axis {x y z} { set pos [expr {0.01*$_settings($this-${axis}cutposition)}] SendCmd "cutplane position $pos $axis $vols" } SendCmd "volume data state $_settings($this-volume)" EventuallyResizeLegend # Actually write the commands to the server socket. If it fails, we don't # care. We're finished here. blt::busy hold $itk_component(hull) StopBufferingCommands blt::busy release $itk_component(hull) set _reset 0 } # ---------------------------------------------------------------------- # USAGE: CurrentVolumeIds ?-cutplanes? # # Returns a list of volume server IDs for the current volume being # displayed. This is normally a single ID, but it might be a list # of IDs if the current data object has multiple components. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::CurrentVolumeIds {{what -all}} { return "" if { $_first == "" } { return } foreach key [array names _serverObjs *-*] { if {[string match $_first-* $key]} { array set styles { -cutplanes 1 } foreach {dataobj comp} [split $key -] break array set styles [lindex [$dataobj components -style $comp] 0] if {$what != "-cutplanes" || $styles(-cutplanes)} { lappend rlist $_serverObjs($key) } } } return $rlist } # ---------------------------------------------------------------------- # USAGE: Zoom in # USAGE: Zoom out # USAGE: Zoom reset # # Called automatically when the user clicks on one of the zoom # controls for this widget. Changes the zoom for the current view. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::Zoom {option} { switch -- $option { "in" { set _view(-zoom) [expr {$_view(-zoom)*1.25}] set _settings($this-zoom) $_view(-zoom) SendCmd "camera zoom $_view(-zoom)" } "out" { set _view(-zoom) [expr {$_view(-zoom)*0.8}] set _settings($this-zoom) $_view(-zoom) SendCmd "camera zoom $_view(-zoom)" } "reset" { array set _view { -qw 0.853553 -qx -0.353553 -qy 0.353553 -qz 0.146447 -zoom 1.0 -xpan 0 -ypan 0 } if { $_first != "" } { set location [$_first hints camera] if { $location != "" } { array set _view $location } } set q [ViewToQuaternion] $_arcball quaternion $q SendCmd "camera orient $q" SendCmd "camera reset" set _settings($this-qw) $_view(-qw) set _settings($this-qx) $_view(-qx) set _settings($this-qy) $_view(-qy) set _settings($this-qz) $_view(-qz) set _settings($this-xpan) $_view(-xpan) set _settings($this-ypan) $_view(-ypan) set _settings($this-zoom) $_view(-zoom) } } } itcl::body Rappture::FlowvisViewer::PanCamera {} { set x $_view(-xpan) set y $_view(-ypan) SendCmd "camera pan $x $y" } # ---------------------------------------------------------------------- # USAGE: Rotate click # USAGE: Rotate drag # USAGE: Rotate release # # Called automatically when the user clicks/drags/releases in the # plot area. Moves the plot according to the user's actions. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::Rotate {option x y} { switch -- $option { click { $itk_component(3dview) configure -cursor fleur set _click(x) $x set _click(y) $y } drag { if {[array size _click] == 0} { Rotate click $x $y } else { set w [winfo width $itk_component(3dview)] set h [winfo height $itk_component(3dview)] if {$w <= 0 || $h <= 0} { return } if {[catch { # this fails sometimes for no apparent reason set dx [expr {double($x-$_click(x))/$w}] set dy [expr {double($y-$_click(y))/$h}] }]} { return } set q [$_arcball rotate $x $y $_click(x) $_click(y)] QuaternionToView $q set _settings($this-qw) $_view(-qw) set _settings($this-qx) $_view(-qx) set _settings($this-qy) $_view(-qy) set _settings($this-qz) $_view(-qz) SendCmd "camera orient $q" set _click(x) $x set _click(y) $y } } release { Rotate drag $x $y $itk_component(3dview) configure -cursor "" catch {unset _click} } default { error "bad option \"$option\": should be click, drag, release" } } } # ---------------------------------------------------------------------- # USAGE: $this Pan click x y # $this Pan drag x y # $this Pan release x y # # Called automatically when the user clicks on one of the zoom # controls for this widget. Changes the zoom for the current view. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::Pan {option x y} { # Experimental stuff set w [winfo width $itk_component(3dview)] set h [winfo height $itk_component(3dview)] if { $option == "set" } { set x [expr $x / double($w)] set y [expr $y / double($h)] set _view(-xpan) [expr $_view(-xpan) + $x] set _view(-ypan) [expr $_view(-ypan) + $y] PanCamera set _settings($this-xpan) $_view(-xpan) set _settings($this-ypan) $_view(-ypan) return } if { $option == "click" } { set _click(x) $x set _click(y) $y $itk_component(3dview) configure -cursor hand1 } if { $option == "drag" || $option == "release" } { set dx [expr ($_click(x) - $x)/double($w)] set dy [expr ($_click(y) - $y)/double($h)] set _click(x) $x set _click(y) $y set _view(-xpan) [expr $_view(-xpan) - $dx] set _view(-ypan) [expr $_view(-ypan) - $dy] PanCamera set _settings($this-xpan) $_view(-xpan) set _settings($this-ypan) $_view(-ypan) } if { $option == "release" } { $itk_component(3dview) configure -cursor "" } } # ---------------------------------------------------------------------- # USAGE: Flow movie record|stop|play ?on|off|toggle? # # Called when the user clicks on the record, stop or play buttons # for flow visualization. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::Flow {option args} { switch -- $option { movie { if {[llength $args] < 1 || [llength $args] > 2} { error "wrong # args: should be \"Flow movie record|stop|play ?on|off|toggle?\"" } set action [lindex $args 0] set op [lindex $args 1] if {$op == ""} { set op "on" } set current [State $action] if {$op == "toggle"} { if {$current == "on"} { set op "off" } else { set op "on" } } set cmds "" switch -- $action { record { if { [$itk_component(rewind) cget -relief] != "sunken" } { $itk_component(rewind) configure -relief sunken $itk_component(stop) configure -relief raised $itk_component(play) configure -relief raised set inner $itk_component(settingsFrame) set frames [$inner.framecnt value] set _settings(nsteps) $frames set cmds "flow capture $frames" SendCmd $cmds } } stop { if { [$itk_component(stop) cget -relief] != "sunken" } { $itk_component(rewind) configure -relief raised $itk_component(stop) configure -relief sunken $itk_component(play) configure -relief raised _pause set cmds "flow reset" SendCmd $cmds } } play { if { [$itk_component(play) cget -relief] != "sunken" } { $itk_component(rewind) configure -relief raised $itk_component(stop) configure -relief raised $itk_component(play) configure \ -image [Rappture::icon flow-pause] \ -relief sunken bind $itk_component(play) \ [itcl::code $this _pause] flow next } } default { error "bad option \"$option\": should be one of record|stop|play" } } } default { error "bad option \"$option\": should be movie" } } } # ---------------------------------------------------------------------- # USAGE: Play # # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::Play {} { SendCmd "flow next" set delay [expr {int(ceil(pow($_settings(speed)/10.0+2,2.0)*15))}] $_dispatcher event -after $delay !play } # ---------------------------------------------------------------------- # USAGE: Pause # # Invoked when the user hits the "pause" button to stop playing the # current sequence of frames as a movie. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::Pause {} { $_dispatcher cancel !play # Toggle the button to "play" mode $itk_component(play) configure \ -image [Rappture::icon flow-start] \ -relief raised bind $itk_component(play) \ [itcl::code $this Flow movie play toggle] } # ---------------------------------------------------------------------- # USAGE: InitSettings ?? # # Used internally to update rendering settings whenever parameters # change in the popup settings panel. Sends the new settings off # to the back end. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::InitSettings { args } { foreach arg $args { AdjustSetting $arg } } # ---------------------------------------------------------------------- # USAGE: AdjustSetting ?? # # Used internally to update rendering settings whenever parameters # change in the popup settings panel. Sends the new settings off # to the back end. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::AdjustSetting {what {value ""}} { switch -- $what { colormap { set color [$itk_component(colormap) value] set _settings(colormap) $color #ResetColormap $color } ambient { if { $_first != "" } { set comp [lindex [$_first components] 0] set tag $_first-$comp set val $_settings($this-ambient) set val [expr {0.01*$val}] SendCmd "$tag configure -ambient $val" } } diffuse { if { $_first != "" } { set comp [lindex [$_first components] 0] set tag $_first-$comp set val $_settings($this-diffuse) set val [expr {0.01*$val}] SendCmd "$tag configure -diffuse $val" } } specularLevel { if { $_first != "" } { set comp [lindex [$_first components] 0] set tag $_first-$comp set val $_settings($this-specularLevel) set val [expr {0.01*$val}] SendCmd "$tag configure -specularLevel $val" } } specularExponent { if { $_first != "" } { set comp [lindex [$_first components] 0] set tag $_first-$comp set val $_settings($this-specularExponent) SendCmd "$tag configure -specularExp $val" } } light2side { if { $_first != "" } { set comp [lindex [$_first components] 0] set tag $_first-$comp set val $_settings($this-light2side) SendCmd "$tag configure -light2side $val" } } opacity { if { $_first != "" } { set comp [lindex [$_first components] 0] set tag $_first-$comp set opacity [expr { 0.01 * double($_settings($this-opacity)) }] SendCmd "$tag configure -opacity $opacity" } } thickness { if { $_first != "" && $_activeTf != "" } { set val $_settings($this-thickness) # Scale values between 0.00001 and 0.01000 set sval [expr {0.0001*double($val)}] set tf $_activeTf set _settings($this-$tf-thickness) $sval updateTransferFunctions } } "outline" { if { $_first != "" } { set comp [lindex [$_first components] 0] set tag $_first-$comp SendCmd "$tag configure -outline $_settings($this-outline)" } } "isosurface" { if { [isconnected] } { SendCmd "volume shading isosurface $_settings($this-isosurface)" } } "grid" { if { [isconnected] } { SendCmd "grid visible $_settings($this-grid)" } } "axes" { if { [isconnected] } { SendCmd "axis visible $_settings($this-axes)" } } "legend" { if { $_settings($this-legend) } { blt::table $itk_component(plotarea) \ 0,0 $itk_component(3dview) -fill both \ 1,0 $itk_component(legend) -fill x blt::table configure $itk_component(plotarea) r1 -resize none } else { blt::table forget $itk_component(legend) } } "volume" { if { $_first != "" } { set comp [lindex [$_first components] 0] set tag $_first-$comp SendCmd "$tag configure -volume $_settings($this-volume)" } } "cutplaneVisible" { set bool $_settings($this-$what) set datasets [CurrentVolumeIds -cutplanes] set tag [lindex $datasets 0] SendCmd "cutplane visible $bool $tag" } "xcutplane" - "ycutplane" - "zcutplane" { set axis [string range $what 0 0] set bool $_settings($this-$what) if { [isconnected] } { set vols [CurrentVolumeIds -cutplanes] SendCmd "cutplane state $bool $axis $vols" } if { $bool } { $itk_component(${axis}CutScale) configure -state normal \ -troughcolor white } else { $itk_component(${axis}CutScale) configure -state disabled \ -troughcolor grey82 } } default { error "don't know how to fix $what" } } } # ---------------------------------------------------------------------- # USAGE: ResizeLegend # # Used internally to update the legend area whenever it changes size # or when the field changes. Asks the server to send a new legend # for the current field. # ---------------------------------------------------------------------- itcl::body Rappture::FlowvisViewer::ResizeLegend {} { set _resizeLegendPending 0 set lineht [font metrics $itk_option(-font) -linespace] set w [expr {$_width-20}] set h [expr {[winfo height $itk_component(legend)]-20-$lineht}] if { $_first == "" } { return } set comp [lindex [$_first components] 0] set tag $_first-$comp #set _activeTf [lindex $_obj2style($tag) 0] if {$w > 0 && $h > 0 && "" != $_activeTf} { #SendCmd "legend $_activeTf $w $h" SendCmd "$tag legend $w $h" } else { # Can't do this as this will remove the items associated with the # isomarkers. #$itk_component(legend) delete all } } # # NameTransferFunc -- # # Creates a transfer function name based on the