Changeset 4512 for branches/1.3


Ignore:
Timestamp:
Jul 16, 2014 4:24:32 PM (6 years ago)
Author:
gah
Message:

test and fixes for meshviewer, add rappture (non-viewer) bug fixes and features

Location:
branches/1.3/gui/scripts
Files:
7 added
11 edited

Legend:

Unmodified
Added
Removed
  • branches/1.3/gui/scripts/Makefile.in

    r4504 r4512  
    3333                $(srcdir)/controlOwner.tcl \
    3434                $(srcdir)/controls.tcl \
     35                $(srcdir)/coverflow.tcl \
    3536                $(srcdir)/curve.tcl \
    3637                $(srcdir)/datatable.tcl \
     
    5152                $(srcdir)/field.tcl \
    5253                $(srcdir)/fieldresult.tcl \
     54                $(srcdir)/filechoiceentry.tcl \
     55                $(srcdir)/filelistentry.tcl \
    5356                $(srcdir)/filexfer.tcl \
    5457                $(srcdir)/flowdial.tcl \
     
    6972                $(srcdir)/integerentry.tcl \
    7073                $(srcdir)/isomarker.tcl \
     74                $(srcdir)/transferfunctioneditor.tcl \
    7175                $(srcdir)/loader.tcl \
    7276                $(srcdir)/logger.tcl \
    7377                $(srcdir)/main.tcl \
    7478                $(srcdir)/mainwin.tcl \
     79                $(srcdir)/map.tcl \
     80                $(srcdir)/mapviewer.tcl \
    7581                $(srcdir)/mesh.tcl \
    7682                $(srcdir)/meshresult.tcl \
     
    9298                $(srcdir)/pushbutton.tcl \
    9399                $(srcdir)/radiodial.tcl \
    94                 $(srcdir)/resources.tcl \
    95100                $(srcdir)/resultset.tcl \
    96101                $(srcdir)/resultselector.tcl \
     
    111116                $(srcdir)/tool.tcl \
    112117                $(srcdir)/tooltip.tcl \
    113                 $(srcdir)/transferfunctioneditor.tcl \
    114118                $(srcdir)/tuples.tcl \
     119                $(srcdir)/tweener.tcl \
    115120                $(srcdir)/unirect2d.tcl \
    116121                $(srcdir)/unirect3d.tcl \
     
    137142                $(srcdir)/vtkvolumeviewer.tcl \
    138143                $(srcdir)/vtkheightmapviewer.tcl \
     144                $(srcdir)/vtkimageviewer.tcl \
    139145                $(srcdir)/xylegend.tcl \
    140146                $(srcdir)/xyprint.tcl \
  • branches/1.3/gui/scripts/analyzer.tcl

    r4408 r4512  
    800800                        _autoLabel $xmlobj output.$item "Integer" counters
    801801                    }
     802                    mesh* {
     803                        _autoLabel $xmlobj output.$item "Mesh" counters
     804                    }
    802805                    string* {
    803806                        _autoLabel $xmlobj output.$item "String" counters
    804807                    }
    805                     histogram* - curve* - field* {
     808                    histogram* - curve* - field* - map* {
    806809                        _autoLabel $xmlobj output.$item "Plot" counters
    807810                    }
  • branches/1.3/gui/scripts/bugreport.tcl

    r4457 r4512  
    8686        set w [winfo reqwidth .bugreport]
    8787        set h [winfo reqheight .bugreport]
    88         #gah@purdue: temporary hack to force view of dismiss button
    89         incr h 300
    90         set x [expr {([winfo screenwidth .bugreport]-$w)/2}]
     88
     89        set rootx [winfo rootx .main]
     90        set rooty [winfo rooty .main]
     91        set mw [winfo reqwidth .main]
     92        set mh [winfo reqheight .main]
     93       
     94        set x [expr { $rootx + (($mw-$w)/2) }]
    9195        if {$x < 0} {set x 0}
    92         set y [expr {([winfo screenheight .bugreport]-$h)/2}]
     96        set y [expr { $rooty + (($mh-$h)/2) }]
    9397        if {$y < 0} {set y 0}
    94 
     98       
    9599        wm geometry .bugreport +$x+$y
    96100        raise .bugreport
     
    146150    set w [winfo reqwidth .bugreport]
    147151    set h [winfo reqheight .bugreport]
    148     set x [expr {([winfo screenwidth .bugreport]-$w)/2}]
     152
     153    set rootx [winfo rootx .main]
     154    set rooty [winfo rooty .main]
     155    set mw [winfo reqwidth .main]
     156    set mh [winfo reqheight .main]
     157
     158    set x [expr { $rootx + (($mw-$w)/2) }]
    149159    if {$x < 0} {set x 0}
    150     set y [expr {([winfo screenheight .bugreport]-$h)/2}]
     160    set y [expr { $rooty + (($mh-$h)/2) }]
    151161    if {$y < 0} {set y 0}
    152162
  • branches/1.3/gui/scripts/controls.tcl

    r4069 r4512  
    139139        choice {
    140140            Rappture::ChoiceEntry $w $_owner $path
     141            bind $w <<Value>> [itcl::code $this _controlChanged $name]
     142        }
     143        filechoice {
     144            Rappture::FileChoiceEntry $w $_owner $path
     145            bind $w <<Value>> [itcl::code $this _controlChanged $name]
     146        }
     147        filelist {
     148            Rappture::FileListEntry $w $_owner $path
    141149            bind $w <<Value>> [itcl::code $this _controlChanged $name]
    142150        }
  • branches/1.3/gui/scripts/field.tcl

    r4504 r4512  
    321321    }
    322322    if {[info exists _comp2dx($cname)]} {
    323         return ""  ;# no mesh -- it's embedded in the value data
     323        return ""  ;# no mesh -- it's embedded in the blob data
    324324    }
    325325    if {[info exists _comp2mesh($cname)]} {
     
    405405}
    406406
     407# ----------------------------------------------------------------------
     408# USAGE: valueLimits <cname>
     409#
     410# Returns an array for the requested component with a list {min max}
     411# representing the limits for each axis.
     412# ----------------------------------------------------------------------
    407413itcl::body Rappture::Field::valueLimits { cname } {
    408414    if { [info exists _comp2limits($cname)] } {
     
    919925                close $f
    920926            }
    921             # This is temporary.  I put a check for this in the DxToVtk
    922             # parser. 
    923             if { [string range $contents  0 3] == "<DX>" } {
    924                 set contents [string range $contents 4 end]
    925             }
    926927            if { [catch { Rappture::DxToVtk $contents } vtkdata] == 0 } {
    927928                ReadVtkDataSet $cname $vtkdata
     929                if 0 {
     930                    set f [open /tmp/$_path.$cname.vtk "w"]
     931                    puts -nonewline $f $vtkdata
     932                    close $f
     933                }
    928934            } else {
    929935                puts stderr "Can't parse dx data: $vtkdata"
    930             }
    931             if 0 {
    932                 set f [open /tmp/$_path.$cname.vtk "w"]
    933                 puts -nonewline $f $vtkdata
    934                 close $f
    935936            }
    936937            if { $_alwaysConvertDX ||
  • branches/1.3/gui/scripts/mesh.tcl

    r4474 r4512  
    8585    private method WriteTriangles { path xv yv zv triangles }
    8686    private method WriteQuads { path xv yv zv quads }
     87    private method WriteVertices { path xv yv zv vertices }
     88    private method WriteLines { path xv yv zv lines }
     89    private method WritePolygons { path xv yv zv polygons }
     90    private method WriteTriangleStrips { path xv yv zv trianglestrips }
    8791    private method WriteTetrahedrons { path xv yv zv tetrahedrons }
    8892    private method WriteHexahedrons { path xv yv zv hexhedrons }
     
    860864}
    861865
     866itcl::body Rappture::Mesh::WriteVertices { path xv yv zv vertices } {
     867    set _type "vertices"
     868    set _numPoints [$xv length]
     869    set _numCells 0
     870    set data {}
     871    set lines [split $vertices \n]
     872    set count 0
     873    foreach { line } $lines {
     874        set numIndices [llength $line]
     875        if { $numIndices == 0 } {
     876            continue
     877        }
     878        append data " $numIndices $line\n"
     879        incr _numCells
     880        set count [expr $count + $numIndices + 1]
     881    }
     882    append out "DATASET POLYDATA\n"
     883    append out "POINTS $_numPoints double\n"
     884    foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] {
     885        append out " $x $y $z\n"
     886    }
     887    append out "VERTICES $_numCells $count\n"
     888    append out $data
     889    set _limits(x) [$xv limits]
     890    set _limits(y) [$yv limits]
     891    if { $_dim == 3 } {
     892        set _limits(z) [$zv limits]
     893    } else {
     894        set _limits(z) [list 0 0]
     895    }
     896    set _vtkdata $out
     897    return 1
     898}
     899
     900itcl::body Rappture::Mesh::WriteLines { path xv yv zv polylines } {
     901    set _type "lines"
     902    set _numPoints [$xv length]
     903    set _numCells 0
     904    set data {}
     905    set lines [split $polylines \n]
     906    set count 0
     907    foreach { line } $lines {
     908        set numIndices [llength $line]
     909        if { $numIndices == 0 } {
     910            continue
     911        }
     912        append data " $numIndices $line\n"
     913        incr _numCells
     914        set count [expr $count + $numIndices + 1]
     915    }
     916    append out "DATASET POLYDATA\n"
     917    append out "POINTS $_numPoints double\n"
     918    foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] {
     919        append out " $x $y $z\n"
     920    }
     921    append out "LINES $_numCells $count\n"
     922    append out $data
     923    set _limits(x) [$xv limits]
     924    set _limits(y) [$yv limits]
     925    if { $_dim == 3 } {
     926        set _limits(z) [$zv limits]
     927    } else {
     928        set _limits(z) [list 0 0]
     929    }
     930    set _vtkdata $out
     931    return 1
     932}
     933
     934itcl::body Rappture::Mesh::WritePolygons { path xv yv zv polygons } {
     935    set _type "polygons"
     936    set _numPoints [$xv length]
     937    set _numCells 0
     938    set data {}
     939    set lines [split $polygons \n]
     940    set count 0
     941    foreach { line } $lines {
     942        set numIndices [llength $line]
     943        if { $numIndices == 0 } {
     944            continue
     945        }
     946        append data " $numIndices $line\n"
     947        incr _numCells
     948        set count [expr $count + $numIndices + 1]
     949    }
     950    append out "DATASET POLYDATA\n"
     951    append out "POINTS $_numPoints double\n"
     952    foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] {
     953        append out " $x $y $z\n"
     954    }
     955    append out "POLYGONS $_numCells $count\n"
     956    append out $data
     957    set _limits(x) [$xv limits]
     958    set _limits(y) [$yv limits]
     959    if { $_dim == 3 } {
     960        set _limits(z) [$zv limits]
     961    } else {
     962        set _limits(z) [list 0 0]
     963    }
     964    set _vtkdata $out
     965    return 1
     966}
     967
     968itcl::body Rappture::Mesh::WriteTriangleStrips { path xv yv zv trianglestrips } {
     969    set _type "trianglestrips"
     970    set _numPoints [$xv length]
     971    set _numCells 0
     972    set data {}
     973    set lines [split $trianglestrips \n]
     974    set count 0
     975    foreach { line } $lines {
     976        set numIndices [llength $line]
     977        if { $numIndices == 0 } {
     978            continue
     979        }
     980        append data " $numIndices $line\n"
     981        incr _numCells
     982        set count [expr $count + $numIndices + 1]
     983    }
     984    append out "DATASET POLYDATA\n"
     985    append out "POINTS $_numPoints double\n"
     986    foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] {
     987        append out " $x $y $z\n"
     988    }
     989    append out "TRIANGLE_STRIPS $_numCells $count\n"
     990    append out $data
     991    set _limits(x) [$xv limits]
     992    set _limits(y) [$yv limits]
     993    if { $_dim == 3 } {
     994        set _limits(z) [$zv limits]
     995    } else {
     996        set _limits(z) [list 0 0]
     997    }
     998    set _vtkdata $out
     999    return 1
     1000}
     1001
    8621002itcl::body Rappture::Mesh::WriteTetrahedrons { path xv yv zv tetras } {
    8631003    set _type "tetrahedrons"
     
    10401180    # Step 1: Verify that there's only one cell tag of any kind.
    10411181    set numCells 0
    1042     foreach type { cells triangles quads tetrahedrons
    1043         hexahedrons wedges pyramids } {
     1182    foreach type {
     1183        cells
     1184        hexahedrons
     1185        lines
     1186        polygons
     1187        pyramids
     1188        quads
     1189        tetrahedrons
     1190        triangles
     1191        trianglestrips
     1192        vertices
     1193        wedges
     1194    } {
    10441195        set data [$_xmlobj get $path.unstructured.$type]
    10451196        if { $data != "" } {
     
    10571208        return 0
    10581209    }
    1059     foreach type { cells triangles quads tetrahedrons
    1060         hexahedrons wedges pyramids } {
     1210    foreach type { cells
     1211        vertices lines polygons trianglestrips
     1212        triangles quads
     1213        tetrahedrons hexahedrons wedges pyramids } {
    10611214        set data [$_xmlobj get $path.unstructured.$type]
    10621215        if { $data != "" } {
     
    12991452itcl::body Rappture::Mesh::GetCellType { name } {
    13001453    array set name2type {
    1301         "triangle"     5
    1302         "quad"         9
    1303         "tetrahedron"  10
    1304         "hexahedron"   12
    1305         "wedge"        13
    1306         "pyramid"      14
     1454        "vertex"          1
     1455        "polyvertex"      2
     1456        "line"            3
     1457        "polyline"        4
     1458        "triangle"        5
     1459        "trianglestrip"   6
     1460        "polygon"         7
     1461        "pixel"           8
     1462        "quad"            9
     1463        "tetrahedron"     10
     1464        "voxel"           11
     1465        "hexahedron"      12
     1466        "wedge"           13
     1467        "pyramid"         14
     1468        "pentagonalprism" 15
     1469        "hexagonalprism"  16
    13071470    }
    13081471    if { [info exists name2type($name)] } {
     
    13311494        13      6
    13321495        14      5
    1333         15      0
    1334         16      0
     1496        15      10
     1497        16      12
    13351498    }
    13361499    if { [info exists type2indices($type)] } {
  • branches/1.3/gui/scripts/resultviewer.tcl

    r4481 r4512  
    293293            }
    294294        }
     295        ::Rappture::Map {
     296            if { ![$dataobj isvalid] } {
     297                return;                 # Ignore invalid map objects.
     298            }
     299            set mode "map"
     300            if {![info exists _mode2widget($mode)]} {
     301                set servers [Rappture::VisViewer::GetServerList "geovis"]
     302                set w $itk_interior.$mode
     303                Rappture::MapViewer $w $servers
     304                set _mode2widget($mode) $w
     305            }
     306        }
    295307        ::Rappture::Field {
    296308            if { ![$dataobj isvalid] } {
     
    481493            set dobj [Rappture::Field ::#auto $xmlobj $path]
    482494        }
     495        map {
     496            set dobj [Rappture::Map ::#auto $xmlobj $path]
     497        }
    483498        mesh {
    484499            set dobj [Rappture::Mesh ::#auto $xmlobj $path]
  • branches/1.3/gui/scripts/tuples.tcl

    r3330 r4512  
    7070                value -default ""
    7171            }
     72
     73            # FIXME: This is a band-aid.  The value can be an arbitrary
     74            # string and therefore misinterpretered as an invalid list.
     75            # Try to parse the value as a list and if that fails make a
     76            # list out of it.  Hopefully this doesn't break run file
     77            # comparisons.
     78            if { [catch {llength $params(-default)}] != 0 } {
     79                set params(-default) [list $params(-default)]
     80            }
     81
    7282            if {[llength $args] != 0} {
    7383                error "wrong # args: should be \"column insert pos ?-name n? ?-label l? ?-default v?\""
  • branches/1.3/gui/scripts/visviewer.tcl

    r4496 r4512  
    454454    set _done($this) 1
    455455    set _buffer(out) $bytes
     456
     457    # There's problem when the user is interacting with the GUI at the
     458    # same time we're trying to write to the server.  Don't want to
     459    # block because, the GUI will look like it's dead.  We can start
     460    # by putting a busy window over plot so that inadvertent things like
     461    # mouse movements aren't received.
     462
     463    blt::busy hold $itk_component(main)
    456464    fileevent $_sid writable [itcl::code $this SendHelper]
    457465    tkwait variable ::Rappture::VisViewer::_done($this)
     466    blt::busy release $itk_component(main)
     467
    458468    set _buffer(out) ""
    459469    if { [IsConnected] } {
  • branches/1.3/gui/scripts/vtkisosurfaceviewer.tcl

    r4504 r4512  
    6363    public method scale {args}
    6464
    65     protected method Connect {}
    66     protected method CurrentDatasets {args}
    67     protected method Disconnect {}
    68     protected method DoResize {}
    69     protected method DoRotate {}
    70     protected method DoChangeContourLevels {}
    71     protected method AdjustSetting {what {value ""}}
    72     protected method InitSettings { args  }
    73     protected method Pan {option x y}
    74     protected method Pick {x y}
    75     protected method Rebuild {}
    76     protected method ReceiveDataset { args }
    77     protected method ReceiveImage { args }
    78     protected method ReceiveLegend { colormap title vmin vmax size }
    79     protected method Rotate {option x y}
    80     protected method Zoom {option}
    81 
    8265    # The following methods are only used by this class.
     66
     67    private method AdjustSetting {what {value ""}}
    8368    private method BuildAxisTab {}
    8469    private method BuildCameraTab {}
     
    8873    private method BuildIsosurfaceTab {}
    8974    private method Combo { option }
     75    private method Connect {}
     76    private method CurrentDatasets {args}
     77    private method Disconnect {}
     78    private method DoChangeContourLevels {}
     79    private method DoResize {}
     80    private method DoRotate {}
    9081    private method DrawLegend {}
    9182    private method EnterLegend { x y }
     83    private method EventuallyChangeContourLevels {}
     84    private method EventuallyRequestLegend {}
    9285    private method EventuallyResize { w h }
    93     private method EventuallyChangeContourLevels {}
    9486    private method EventuallyRotate { q }
    95     private method EventuallyRequestLegend {}
    9687    private method EventuallySetCutplane { axis args }
     88    private method GenerateContourList {}
    9789    private method GetImage { args }
    9890    private method GetVtkData { args }
     91    private method InitSettings { args  }
    9992    private method IsValidObject { dataobj }
    10093    private method LeaveLegend {}
    10194    private method MotionLegend { x y }
     95    private method Pan {option x y}
    10296    private method PanCamera {}
     97    private method Pick {x y}
     98    private method Rebuild {}
     99    private method ReceiveDataset { args }
     100    private method ReceiveImage { args }
     101    private method ReceiveLegend { colormap title vmin vmax size }
    103102    private method RequestLegend {}
     103    private method Rotate {option x y}
     104    private method SetCurrentColormap { color }
    104105    private method SetLegendTip { x y }
    105106    private method SetObjectStyle { dataobj comp }
     107    private method SetOrientation { side }
    106108    private method Slice {option args}
    107     private method SetCurrentColormap { color }
    108     private method SetOrientation { side }
    109     private method GenerateContourList {}
     109    private method Zoom {option}
     110    private method ViewToQuaternion {} {
     111        return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)]
     112    }
    110113
    111114    private variable _arcball ""
     
    216219    # Initialize the view to some default parameters.
    217220    array set _view {
    218         qw              0.853553
    219         qx              -0.353553
    220         qy              0.353553
    221         qz              0.146447
    222         zoom            1.0
    223         xpan            0
    224         ypan            0
    225         ortho           0
     221        -ortho           0
     222        -qw              0.853553
     223        -qx              -0.353553
     224        -qy              0.353553
     225        -qz              0.146447
     226        -xpan            0
     227        -ypan            0
     228        -zoom            1.0
    226229    }
    227230    set _arcball [blt::arcball create 100 100]
    228     set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
    229     $_arcball quaternion $q
     231    $_arcball quaternion [ViewToQuaternion]
    230232
    231233    array set _contourList {
     
    275277    }
    276278    array set _widget {
    277         -isosurfaceopacity       0
    278         -cutplaneopacity         0
     279        -isosurfaceopacity       60
     280        -cutplaneopacity         100
    279281    }
    280282
     
    496498
    497499itcl::body Rappture::VtkIsosurfaceViewer::DoRotate {} {
    498     set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
    499     SendCmd "camera orient $q"
     500    SendCmd "camera orient [ViewToQuaternion]"
    500501    set _rotatePending 0
    501502}
     
    521522
    522523itcl::body Rappture::VtkIsosurfaceViewer::EventuallyRotate { q } {
    523     foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break
     524    foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break
    524525    if { !$_rotatePending } {
    525526        set _rotatePending 1
     
    982983        $_arcball resize $w $h
    983984        DoResize
    984         #
     985
    985986        # Reset the camera and other view parameters
    986         #
    987         set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
    988         $_arcball quaternion $q
    989         if {$_view(ortho)} {
    990             SendCmd "camera mode ortho"
    991         } else {
    992             SendCmd "camera mode persp"
    993         }
     987        $_arcball quaternion [ViewToQuaternion]
    994988        DoRotate
    995989        PanCamera
    996990        set _first ""
    997991        InitSettings -xgrid -ygrid -zgrid -axismode \
    998             -axesvisible -axislabelsvisible
     992            -axesvisible -axislabelsvisible -ortho
    999993        SendCmd "axis lformat all %g"
    1000994        # Too many major ticks, so turn off minor ticks
     
    11811175    switch -- $option {
    11821176        "in" {
    1183             set _view(zoom) [expr {$_view(zoom)*1.25}]
    1184             SendCmd "camera zoom $_view(zoom)"
     1177            set _view(-zoom) [expr {$_view(-zoom)*1.25}]
     1178            SendCmd "camera zoom $_view(-zoom)"
    11851179        }
    11861180        "out" {
    1187             set _view(zoom) [expr {$_view(zoom)*0.8}]
    1188             SendCmd "camera zoom $_view(zoom)"
     1181            set _view(-zoom) [expr {$_view(-zoom)*0.8}]
     1182            SendCmd "camera zoom $_view(-zoom)"
    11891183        }
    11901184        "reset" {
    11911185            array set _view {
    1192                 qw     0.853553
    1193                 qx     -0.353553
    1194                 qy     0.353553
    1195                 qz     0.146447
    1196                 zoom   1.0
    1197                 xpan   0
    1198                 ypan   0
     1186                -qw     0.853553
     1187                -qx     -0.353553
     1188                -qy     0.353553
     1189                -qz     0.146447
     1190                -xpan   0
     1191                -ypan   0
     1192                -zoom   1.0
    11991193            }
    12001194            if { $_first != "" } {
     
    12041198                }
    12051199            }
    1206             set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
    1207             $_arcball quaternion $q
     1200            $_arcball quaternion [ViewToQuaternion]
    12081201            DoRotate
    12091202            SendCmd "camera reset"
     
    12131206
    12141207itcl::body Rappture::VtkIsosurfaceViewer::PanCamera {} {
    1215     set x $_view(xpan)
    1216     set y $_view(ypan)
     1208    set x $_view(-xpan)
     1209    set y $_view(-ypan)
    12171210    SendCmd "camera pan $x $y"
    12181211}
     
    12921285            set x [expr $x / double($w)]
    12931286            set y [expr $y / double($h)]
    1294             set _view(xpan) [expr $_view(xpan) + $x]
    1295             set _view(ypan) [expr $_view(ypan) + $y]
     1287            set _view(-xpan) [expr $_view(-xpan) + $x]
     1288            set _view(-ypan) [expr $_view(-ypan) + $y]
    12961289            PanCamera
    12971290            return
     
    13151308            set _click(x) $x
    13161309            set _click(y) $y
    1317             set _view(xpan) [expr $_view(xpan) - $dx]
    1318             set _view(ypan) [expr $_view(ypan) - $dy]
     1310            set _view(-xpan) [expr $_view(-xpan) - $dx]
     1311            set _view(-ypan) [expr $_view(-ypan) - $dy]
    13191312            PanCamera
    13201313        }
     
    13581351    }
    13591352    switch -- $what {
     1353        "-axesvisible" {
     1354            set bool $_settings($what)
     1355            SendCmd "axis visible all $bool"
     1356        }
     1357        "-axislabelsvisible" {
     1358            set bool $_settings($what)
     1359            SendCmd "axis labels all $bool"
     1360        }
     1361        "-xgrid" - "-ygrid" - "-zgrid" {
     1362            set axis [string tolower [string range $what 1 1]]
     1363            set bool $_settings($what)
     1364            SendCmd "axis grid $axis $bool"
     1365        }
     1366        "-axismode" {
     1367            set mode [$itk_component(axisMode) value]
     1368            set mode [$itk_component(axisMode) translate $mode]
     1369            set _settings($what) $mode
     1370            SendCmd "axis flymode $mode"
     1371        }
    13601372        "-background" {
    13611373            set bgcolor [$itk_component(background) value]
     
    13701382            DrawLegend
    13711383        }
    1372         "-axesvisible" {
    1373             set bool $_settings(-axesvisible)
    1374             SendCmd "axis visible all $bool"
    1375         }
    1376         "-axislabelsvisible" {
    1377             set bool $_settings(-axislabelsvisible)
    1378             SendCmd "axis labels all $bool"
    1379         }
    1380         "-xgrid" - "-ygrid" - "-zgrid" {
    1381             set axis [string tolower [string range $what 1 1]]
    1382             set bool $_settings($what)
    1383             SendCmd "axis grid $axis $bool"
    1384         }
    1385         "-axismode" {
    1386             set mode [$itk_component(axisMode) value]
    1387             set mode [$itk_component(axisMode) translate $mode]
    1388             set _settings($what) $mode
    1389             SendCmd "axis flymode $mode"
    1390         }
    13911384        "-cutplaneedges" {
    13921385            set bool $_settings($what)
    13931386            SendCmd "cutplane edges $bool"
     1387        }
     1388        "-cutplanelighting" {
     1389            set bool $_settings($what)
     1390            SendCmd "cutplane lighting $bool"
     1391        }
     1392        "-cutplaneopacity" {
     1393            set _settings($what) [expr $_widget($what) * 0.01]
     1394            SendCmd "cutplane opacity $_settings($what)"
     1395        }
     1396        "-cutplanepreinterp" {
     1397            set bool $_settings($what)
     1398            SendCmd "cutplane preinterp $bool"
    13941399        }
    13951400        "-cutplanesvisible" {
     
    14131418            SendCmd "cutplane wireframe $bool"
    14141419        }
    1415         "-cutplanelighting" {
    1416             set bool $_settings($what)
    1417             SendCmd "cutplane lighting $bool"
    1418         }
    1419         "-cutplaneopacity" {
    1420             set _settings($what) [$_widget(-cutplaneopacity) * 0.01]
    1421             SendCmd "cutplane opacity $_settings($what)"
    1422         }
    1423         "-cutplanepreinterp" {
    1424             set bool $_settings($what)
    1425             SendCmd "cutplane preinterp $bool"
    1426         }
    1427         "-xcutplanevisible" - "-ycutplanevisible" - "-zcutplanevisible" {
    1428             set axis [string tolower [string range $what 1 1]]
    1429             set bool $_settings($what)
    1430             if { $bool } {
    1431                 $itk_component(${axis}position) configure -state normal \
    1432                     -troughcolor white
    1433             } else {
    1434                 $itk_component(${axis}position) configure -state disabled \
    1435                     -troughcolor grey82
    1436             }
    1437             SendCmd "cutplane axis $axis $bool"
    1438         }
    1439         "-xcutplaneposition" - "-ycutplaneposition" - "-zcutplaneposition" {
    1440             set axis [string tolower [string range $what 1 1]]
    1441             set pos [expr $_settings($what) * 0.01]
    1442             SendCmd "cutplane slice ${axis} ${pos}"
    1443             set _cutplanePending 0
    1444         }
    14451420        "-colormap" {
    14461421            set _changed($what) 1
    14471422            StartBufferingCommands
    14481423            set color [$itk_component(colormap) value]
    1449             set _settings(-colormap) $color
     1424            set _settings($what) $color
    14501425            if { $color == "none" } {
    14511426                if { $_settings(-colormapvisible) } {
     
    14631438            EventuallyRequestLegend
    14641439        }
    1465         "-numcontours" {
    1466             set _settings($what) [$itk_component(numcontours) value]
    1467             if { $_contourList(numLevels) != $_settings($what) } {
    1468                 set _contourList(numLevels) $_settings($what)
    1469                 EventuallyChangeContourLevels
    1470             }
    1471         }
    1472         "-isosurfacewireframe" {
    1473             set bool $_settings($what)
    1474             SendCmd "contour3d wireframe $bool"
    1475         }
    1476         "-isosurfacevisible" {
    1477             set bool $_settings($what)
    1478             SendCmd "contour3d visible 0"
    1479             if { $bool } {
    1480                 foreach tag [CurrentDatasets -visible] {
    1481                     SendCmd "contour3d visible $bool $tag"
    1482                 }
    1483             }
    1484             if { $bool } {
    1485                 Rappture::Tooltip::for $itk_component(contour) \
    1486                     "Hide the isosurface"
    1487             } else {
    1488                 Rappture::Tooltip::for $itk_component(contour) \
    1489                     "Show the isosurface"
    1490             }
    1491         }
    1492         "-isosurfacelighting" {
    1493             set bool $_settings($what)
    1494             SendCmd "contour3d lighting $bool"
    1495         }
    1496         "-isosurfaceedges" {
    1497             set bool $_settings($what)
    1498             SendCmd "contour3d edges $bool"
    1499         }
    1500         "-outline" {
    1501             set bool $_settings($what)
    1502             SendCmd "outline visible 0"
    1503             if { $bool } {
    1504                 foreach tag [CurrentDatasets -visible] {
    1505                     SendCmd "outline visible $bool $tag"
    1506                 }
    1507             }
    1508         }
    1509         "-isolinecolor" {
    1510             set color [$itk_component(isolineColor) value]
    1511             set _settings($what) $color
    1512             DrawLegend
    1513         }
    1514         "-isosurfaceopacity" {
    1515             set _settings($what) [$_widget(-isosurfaceopacity) * 0.01]
    1516             SendCmd "contour3d opacity $_settings($what)"
    1517         }
    15181440        "-field" {
    15191441            set label [$itk_component(field) value]
     
    15421464            SendCmd "contour3d colormode $_colorMode $_curFldName"
    15431465            SendCmd "camera reset"
    1544             UpdateContourList
     1466            GenerateContourList
    15451467            DrawLegend
     1468        }
     1469        "-isolinecolor" {
     1470            set color [$itk_component(isolineColor) value]
     1471            set _settings(-isolinecolor) $color
     1472            set _settings($what) $color
     1473            DrawLegend
     1474        }
     1475        "-isosurfaceedges" {
     1476            set bool $_settings($what)
     1477            SendCmd "contour3d edges $bool"
     1478        }
     1479        "-isosurfacelighting" {
     1480            set bool $_settings($what)
     1481            SendCmd "contour3d lighting $bool"
     1482        }
     1483        "-isosurfaceopacity" {
     1484            set _settings($what) [expr $_widget($what) * 0.01]
     1485            SendCmd "contour3d opacity $_settings($what)"
     1486        }
     1487        "-isosurfacevisible" {
     1488            set bool $_settings($what)
     1489            SendCmd "contour3d visible 0"
     1490            if { $bool } {
     1491                foreach tag [CurrentDatasets -visible] {
     1492                    SendCmd "contour3d visible $bool $tag"
     1493                }
     1494            }
     1495            if { $bool } {
     1496                Rappture::Tooltip::for $itk_component(contour) \
     1497                    "Hide the isosurface"
     1498            } else {
     1499                Rappture::Tooltip::for $itk_component(contour) \
     1500                    "Show the isosurface"
     1501            }
     1502        }
     1503        "-isosurfacewireframe" {
     1504            set bool $_settings($what)
     1505            SendCmd "contour3d wireframe $bool"
    15461506        }
    15471507        "-legendvisible" {
     
    15501510            }
    15511511            DrawLegend
     1512        }
     1513        "-numcontours" {
     1514            set _settings($what) [$itk_component(numcontours) value]
     1515            if { $_contourList(numLevels) != $_settings($what) } {
     1516                set _contourList(numLevels) $_settings($what)
     1517                EventuallyChangeContourLevels
     1518            }
     1519        }
     1520        "-ortho" {
     1521            set bool $_view($what)
     1522            if { $bool } {
     1523                SendCmd "camera mode ortho"
     1524            } else {
     1525                SendCmd "camera mode persp"
     1526            }
     1527        }
     1528        "-outline" {
     1529            set bool $_settings($what)
     1530            SendCmd "outline visible 0"
     1531            if { $bool } {
     1532                foreach tag [CurrentDatasets -visible] {
     1533                    SendCmd "outline visible $bool $tag"
     1534                }
     1535            }
     1536        }
     1537        "-xcutplanevisible" - "-ycutplanevisible" - "-zcutplanevisible" {
     1538            set axis [string tolower [string range $what 1 1]]
     1539            set bool $_settings($what)
     1540            if { $bool } {
     1541                $itk_component(${axis}position) configure -state normal \
     1542                    -troughcolor white
     1543            } else {
     1544                $itk_component(${axis}position) configure -state disabled \
     1545                    -troughcolor grey82
     1546            }
     1547            SendCmd "cutplane axis $axis $bool"
     1548        }
     1549        "-xcutplaneposition" - "-ycutplaneposition" - "-zcutplaneposition" {
     1550            set axis [string tolower [string range $what 1 1]]
     1551            set pos [expr $_settings($what) * 0.01]
     1552            SendCmd "cutplane slice ${axis} ${pos}"
     1553            set _cutplanePending 0
    15521554        }
    15531555        default {
     
    17221724        -showvalue off \
    17231725        -command [itcl::code $this AdjustSetting -isosurfaceopacity]
    1724     $inner.opacity set [expr $_settings(-isosurfaceeopacity) * 100.0]
     1726    set _widget(-isosurfaceopacity) \
     1727        [expr $_settings(-isosurfaceopacity) * 100.0]
    17251728
    17261729    itk_component add field_l {
     
    18661869        label $inner.${tag}label -text $tag -font "Arial 9"
    18671870        entry $inner.${tag} -font "Arial 9"  -bg white \
    1868             -textvariable [itcl::scope _view($tag)]
     1871            -textvariable [itcl::scope _view(-$tag)]
    18691872        bind $inner.${tag} <KeyPress-Return> \
    18701873            [itcl::code $this camera set ${tag}]
     
    18771880    checkbutton $inner.ortho \
    18781881        -text "Orthographic Projection" \
    1879         -variable [itcl::scope _view(ortho)] \
    1880         -command [itcl::code $this camera set ortho] \
     1882        -variable [itcl::scope _view(-ortho)] \
     1883        -command [itcl::code $this AdjustSetting -ortho] \
    18811884        -font "Arial 9"
    18821885    blt::table $inner \
     
    19361939        -showvalue off \
    19371940        -command [itcl::code $this AdjustSetting -cutplaneopacity]
    1938     $inner.opacity set [expr $_settings(-cutplaneopacity) * 100.0]
     1941    set _widget(-cutplaneopacity) [expr $_settings(-cutplaneopacity) * 100.0]
    19391942
    19401943    # X-value slicer...
     
    20572060        }
    20582061        "set" {
    2059             set who [lindex $args 0]
    2060             set x $_view($who)
     2062            set what [lindex $args 0]
     2063            set x $_view($what)
    20612064            set code [catch { string is double $x } result]
    20622065            if { $code != 0 || !$result } {
    20632066                return
    20642067            }
    2065             switch -- $who {
    2066                 "ortho" {
    2067                     if {$_view(ortho)} {
     2068            switch -- $what {
     2069                "-ortho" {
     2070                    if {$_view($what)} {
    20682071                        SendCmd "camera mode ortho"
    20692072                    } else {
     
    20712074                    }
    20722075                }
    2073                 "xpan" - "ypan" {
     2076                "-xpan" - "-ypan" {
    20742077                    PanCamera
    20752078                }
    2076                 "qx" - "qy" - "qz" - "qw" {
    2077                     set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
     2079                "-qx" - "-qy" - "-qz" - "-qw" {
     2080                    set q [ViewToQuaternion]
    20782081                    $_arcball quaternion $q
    20792082                    EventuallyRotate $q
    20802083                }
    2081                 "zoom" {
    2082                     SendCmd "camera zoom $_view(zoom)"
     2084                "-zoom" {
     2085                    SendCmd "camera zoom $_view(-zoom)"
    20832086                }
    20842087             }
     
    25882591        bottom "0.707107 0.707107 0 0"
    25892592    }
    2590     foreach name { qw qx qy qz } value $positions($side) {
     2593    foreach name { -qw -qx -qy -qz } value $positions($side) {
    25912594        set _view($name) $value
    25922595    }
    2593     set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
     2596    set q [ViewToQuaternion]
    25942597    $_arcball quaternion $q
    25952598    SendCmd "camera orient $q"
    25962599    SendCmd "camera reset"
    2597     set _view(xpan) 0
    2598     set _view(ypan) 0
    2599     set _view(zoom) 1.0
     2600    set _view(-xpan) 0
     2601    set _view(-ypan) 0
     2602    set _view(-zoom) 1.0
    26002603}
    26012604
  • branches/1.3/gui/scripts/vtkmeshviewer.tcl

    r4507 r4512  
    8686    private method EventuallyResize { w h }
    8787    private method EventuallyRotate { q }
    88     private method EventuallySetPolydataOpacity { args }
     88    private method EventuallySetPolydataOpacity {}
    8989    private method GetImage { args }
    9090    private method GetVtkData { args }
     
    111111    private variable _view;             # view params for 3D view
    112112    private variable _settings
     113    private variable _widget
    113114    private variable _style;            # Array of current component styles.
    114115    private variable _initialStyle;     # Array of initial component styles.
     
    128129    private variable _polydataOpacityPending 0
    129130    private variable _rotateDelay 150
     131    private variable _opacityDelay 150
    130132}
    131133
     
    188190        -polydataedges          0
    189191        -polydatalighting       1
    190         -polydataopacity        100
     192        -polydataopacity        0.6
    191193        -polydatavisible        1
    192194        -polydatawireframe      0
     
    204206        -zposition              0
    205207    }
     208    array set _widget {
     209        -polydataopacity        0.6
     210    }       
    206211    itk_component add view {
    207212        canvas $itk_component(plotarea).view \
     
    404409    set _polydataOpacityPending 0
    405410    set val $_settings(-polydataopacity)
    406     set sval [expr { 0.01 * double($val) }]
    407     SendCmd "polydata opacity $sval"
    408 }
    409 
    410 itcl::body Rappture::VtkMeshViewer::EventuallySetPolydataOpacity { val } {
    411     set _settings(-polydataopacity) $val
     411    SendCmd "polydata opacity $val"
     412}
     413
     414itcl::body Rappture::VtkMeshViewer::EventuallySetPolydataOpacity {} {
    412415    if { !$_polydataOpacityPending } {
    413416        set _polydataOpacityPending 1
    414         $_dispatcher event -after $_scaleDelay !polydataOpacity
     417        $_dispatcher event -after $_opacityDelay !polydataOpacity
    415418    }
    416419}
     
    868871        }
    869872        lappend _obj2datasets($dataobj) $tag
    870         if { [info exists _obj2ovride($dataobj-raise)] &&
    871              $_obj2ovride($dataobj-raise) } {
     873        if { [info exists _obj2ovride($dataobj-raise)] } {
    872874            SendCmd "dataset visible 1 $tag"
    873             SetOpacity $tag
     875            EventuallySetPolydataOpacity
    874876        }
    875877    }
     
    897899            -polydatavisible -polydatawireframe
    898900 
     901        SendCmd "axis lformat all %g"
     902        # Too many major ticks, so turn off minor ticks
     903        SendCmd "axis minticks all 0"
     904
    899905        set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
    900906        $_arcball quaternion $q
     
    13501356    label $inner.opacity_l -text "Opacity" -font "Arial 9" -anchor w
    13511357    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
    1352         -variable [itcl::scope _settings(-polydataopacity)] \
     1358        -variable [itcl::scope _widget(-polydataopacity)] \
    13531359        -width 10 \
    13541360        -showvalue off \
    13551361        -command [itcl::code $this AdjustSetting -polydataopacity]
    1356     $inner.opacity set $_settings(-polydataopacity)
     1362    $inner.opacity set [expr $_settings(-polydataopacity) * 100.0]
    13571363
    13581364    blt::table $inner \
     
    17351741        -color white
    17361742        -edgecolor black
    1737         -lighting 1
    17381743        -linewidth 1.0
    17391744        -outline 0
    17401745        -polydataedges 1
    1741         -polydataopacity 1.0
     1746        -polydatalighting 1
     1747        -polydataopacity 0.6
    17421748        -polydatavisible 1
    17431749        -polydatawireframe 0
     
    17701776    SendCmd "polydata linewidth $settings(-linewidth) $tag"
    17711777    SendCmd "polydata opacity $settings(-polydataopacity) $tag"
    1772     set _settings(-polydataopacity) [expr 100.0 * $settings(-polydataopacity)]
     1778    set _settings(-polydataopacity) $settings(-polydataopacity)
     1779    set _widget(-polydataopacity) [expr 100.0 * $settings(-polydataopacity)]
    17731780    SendCmd "polydata wireframe $settings(-polydatawireframe) $tag"
    17741781    set _settings(-polydatawireframe) $settings(-polydatawireframe)
Note: See TracChangeset for help on using the changeset viewer.