source: branches/1.3/gui/scripts/unirect2d.tcl @ 4497

Last change on this file since 4497 was 4497, checked in by ldelgass, 7 years ago

merge r4495 from trunk

File size: 9.4 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2
3# ----------------------------------------------------------------------
4#  COMPONENT: unirect2d - represents a uniform rectangular 2-D mesh.
5#
6#  This object represents one field in an XML description of a device.
7#  It simplifies the process of extracting data vectors that represent
8#  the field.
9# ======================================================================
10#  AUTHOR:  Michael McLennan, Purdue University
11#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
12#
13#  See the file "license.terms" for information on usage and
14#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15# ======================================================================
16package require Itcl
17package require BLT
18
19namespace eval Rappture { # forward declaration }
20
21itcl::class Rappture::Unirect2d {
22    private variable _axisOrder "x y"
23    private variable _xMax      0
24    private variable _xMin      0
25    private variable _xNum      0
26    private variable _yMax      0
27    private variable _yMin      0
28    private variable _yNum      0
29    private variable _hints
30    private variable _vtkdata ""
31    private variable _numPoints 0
32
33    private common _xp2obj       ;      # used for fetch/release ref counting
34    private common _obj2ref      ;      # used for fetch/release ref counting
35    private variable _isValid 0;        # Indicates if the data is valid.
36
37    private method GetString { obj path varName }
38    private method GetValue  { obj path varName }
39    private method GetSize   { obj path varName }
40
41    constructor {xmlobj path} {
42        # defined below
43    }
44    destructor {
45        # defined below
46    }
47    public proc fetch {xmlobj path}
48    public proc release {obj}
49    public method limits {axis}
50    public method units { axis }
51    public method label { axis }
52    public method blob {}
53    public method hints {{keyword ""}}
54    public method mesh {}
55    public method dimensions {} {
56        return 2
57    }
58    public method isvalid {} {
59        return $_isValid
60    }
61    public method numpoints {} {
62        return $_numPoints
63    }
64    public method vtkdata {} {
65        return $_vtkdata
66    }
67}
68
69#
70# fetch <xmlobj> <path>
71#
72#    Clients use this instead of a constructor to fetch the Mesh for a
73#    particular <path> in the <xmlobj>.  When the client is done with the mesh,
74#    he calls "release" to decrement the reference count.  When the mesh is no
75#    longer needed, it is cleaned up automatically.
76#
77itcl::body Rappture::Unirect2d::fetch {xmlobj path} {
78    set handle "$xmlobj|$path"
79    if {[info exists _xp2obj($handle)]} {
80        set obj $_xp2obj($handle)
81        incr _obj2ref($obj)
82        return $obj
83    }
84    set obj [Rappture::Unirect2d ::#auto $xmlobj $path]
85    set _xp2obj($handle) $obj
86    set _obj2ref($obj) 1
87    return $obj
88}
89
90# ----------------------------------------------------------------------
91# USAGE: Rappture::Unirect2d::release <obj>
92#
93# Clients call this when they're no longer using a Mesh fetched
94# previously by the "fetch" proc.  This decrements the reference
95# count for the mesh and destroys the object when it is no longer
96# in use.
97# ----------------------------------------------------------------------
98itcl::body Rappture::Unirect2d::release { obj } {
99    if { ![info exists _obj2ref($obj)] } {
100        error "can't find reference count for $obj"
101    }
102    incr _obj2ref($obj) -1
103    if {$_obj2ref($obj) <= 0} {
104        unset _obj2ref($obj)
105        foreach handle [array names _xp2obj] {
106            if {$_xp2obj($handle) == $obj} {
107                unset _xp2obj($handle)
108            }
109        }
110        itcl::delete object $obj
111    }
112}
113
114# ----------------------------------------------------------------------
115# Constructor
116# ----------------------------------------------------------------------
117itcl::body Rappture::Unirect2d::constructor {xmlobj path} {
118    if {![Rappture::library isvalid $xmlobj]} {
119        error "bad value \"$xmlobj\": should be Rappture::library"
120    }
121    set m [$xmlobj element -as object $path]
122    GetValue $m "xaxis.min" _xMin
123    GetValue $m "xaxis.max" _xMax
124    GetSize $m "xaxis.numpoints" _xNum
125    GetValue $m "yaxis.min" _yMin
126    GetValue $m "yaxis.max" _yMax
127    GetSize $m "yaxis.numpoints" _yNum
128    foreach {key path} {
129        group   about.group
130        label   about.label
131        color   about.color
132        style   about.style
133        type    about.type
134        xlabel  xaxis.label
135        xdesc   xaxis.description
136        xunits  xaxis.units
137        xscale  xaxis.scale
138        xmin    xaxis.min
139        xmax    xaxis.max
140        ylabel  yaxis.label
141        ydesc   yaxis.description
142        yunits  yaxis.units
143        yscale  yaxis.scale
144        ymin    yaxis.min
145        ymax    yaxis.max
146        type    about.type
147    } {
148        set str [$m get $path]
149        if {"" != $str} {
150            set _hints($key) $str
151        }
152    }
153    itcl::delete object $m
154    set _numPoints [expr $_xNum * $_yNum]
155    if { $_numPoints == 0 } {
156        set _vtkdata ""
157        return
158    }
159    append out "DATASET STRUCTURED_POINTS\n"
160    append out "DIMENSIONS $_xNum $_yNum 1"
161    set xSpace [expr ($_xMax - $_xMin) / double($_xNum - 1)]
162    set ySpace [expr ($_yMax - $_yMin) / double($_yNum - 1)]
163    append out "SPACING $xSpace $ySpace 0\n"
164    append out "ORIGIN 0 0 0\n"
165    set _vtkdata $out
166    set _isValid 1
167}
168
169# ----------------------------------------------------------------------
170# Destructor
171# ----------------------------------------------------------------------
172itcl::body Rappture::Unirect2d::destructor {} {
173    # empty
174}
175
176# ----------------------------------------------------------------------
177# method blob
178#       Returns a base64 encoded, gzipped Tcl list that represents the
179#       Tcl command and data to recreate the uniform rectangular grid
180#       on the nanovis server.
181# ----------------------------------------------------------------------
182itcl::body Rappture::Unirect2d::blob {} {
183    set data "unirect2d"
184    lappend data "xmin" $_xMin "xmax" $_xMax "xnum" $_xNum
185    lappend data "ymin" $_yMin "ymax" $_yMax "ynum" $_yNum
186    return $data
187}
188
189# ----------------------------------------------------------------------
190# method mesh
191#       Returns a base64 encoded, gzipped Tcl list that represents the
192#       Tcl command and data to recreate the uniform rectangular grid
193#       on the nanovis server.
194# ----------------------------------------------------------------------
195itcl::body Rappture::Unirect2d::mesh {} {
196    lappend out $_xMin $_xMax $_xNum $_yMin $_yMax $_yNum
197    return $out
198}
199
200# ----------------------------------------------------------------------
201# method limits <axis>
202#       Returns a list {min max} representing the limits for the
203#       specified axis.
204# ----------------------------------------------------------------------
205itcl::body Rappture::Unirect2d::limits {which} {
206    set min ""
207    set max ""
208    switch -- $which {
209        x - xlin - xlog {
210            set min $_xMin
211            set max $_xMax
212        }
213        y - ylin - ylog {
214            set min $_yMin
215            set max $_yMax
216        }
217        z - zlin - zlog {
218            set min 0
219            set max 0
220        }
221        default {
222            error "unknown axis description \"$which\""
223        }
224    }
225    return [list $min $max]
226}
227
228#
229# units --
230#
231#       Returns the units of the given axis.
232#
233itcl::body Rappture::Unirect2d::units { axis } {
234    if { [info exists _hints(${axis}units)] } {
235        return $_hints(${axis}units)
236    }
237    return ""
238}
239
240#
241# label --
242#
243#       Returns the label of the given axis.
244#
245itcl::body Rappture::Unirect2d::label { axis } {
246    if { [info exists _hints(${axis}label)] } {
247        return $_hints(${axis}label)
248    }
249    return ""
250}
251
252# ----------------------------------------------------------------------
253# USAGE: hints ?<keyword>?
254#
255# Returns a list of key/value pairs for various hints about plotting
256# this curve.  If a particular <keyword> is specified, then it returns
257# the hint for that <keyword>, if it exists.
258# ----------------------------------------------------------------------
259itcl::body Rappture::Unirect2d::hints { {keyword ""} } {
260    if {[info exists _hints(xlabel)] && "" != $_hints(xlabel)
261        && [info exists _hints(xunits)] && "" != $_hints(xunits)} {
262        set _hints(xlabel) "$_hints(xlabel) ($_hints(xunits))"
263    }
264    if {[info exists _hints(ylabel)] && "" != $_hints(ylabel)
265        && [info exists _hints(yunits)] && "" != $_hints(yunits)} {
266        set _hints(ylabel) "$_hints(ylabel) ($_hints(yunits))"
267    }
268    if {[info exists _hints(group)] && [info exists _hints(label)]} {
269        # pop-up help for each curve
270        set _hints(tooltip) $_hints(label)
271    }
272    if {$keyword != ""} {
273        if {[info exists _hints($keyword)]} {
274            return $_hints($keyword)
275        }
276        return ""
277    }
278    return [array get _hints]
279}
280
281itcl::body Rappture::Unirect2d::GetSize { obj path varName } {
282    set string [$obj get $path]
283    if { [scan $string "%d" value] != 1 || $value < 0 } {
284        puts stderr "can't get size \"$string\" of \"$path\""
285        return
286    }
287    upvar $varName size
288    set size $value
289}
290
291itcl::body Rappture::Unirect2d::GetValue { obj path varName } {
292    set string [$obj get $path]
293    if { [scan $string "%g" value] != 1 } {
294        return
295    }
296    upvar $varName number
297    set number $value
298}
299
300itcl::body Rappture::Unirect2d::GetString { obj path varName } {
301    set string [$obj get $path]
302    if { $string == "" } {
303        puts stderr "can't get string \"$string\" of \"$path\""
304        return
305    }
306    upvar $varName str
307    set str $string
308}
309
310
Note: See TracBrowser for help on using the repository browser.