source: trunk/gui/scripts/cloud.tcl @ 1929

Last change on this file since 1929 was 1929, checked in by gah, 14 years ago
File size: 7.6 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: cloud - represents the mesh for a cloud of points
3#
4#  This object represents the mesh for a cloud of points in an XML
5#  description of a device.  It simplifies the process of extracting
6#  data that represent the mesh.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2005  Purdue Research Foundation
10#
11#  See the file "license.terms" for information on usage and
12#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13# ======================================================================
14package require Itcl
15package require vtk
16
17namespace eval Rappture { # forward declaration }
18
19itcl::class Rappture::Cloud {
20    constructor {xmlobj path} { # defined below }
21    destructor { # defined below }
22
23    public method points {}
24    public method mesh {}
25    public method size {}
26    public method dimensions {}
27    public method limits {which}
28    public method hints {{key ""}}
29
30    public proc fetch {xmlobj path}
31    public proc release {obj}
32
33    private variable _xmlobj ""  ;# ref to XML obj with device data
34    private variable _cloud ""   ;# lib obj representing this cloud
35
36    private variable _units "m m m" ;# system of units for x, y, z
37    private variable _limits        ;# limits xmin, xmax, ymin, ymax, ...
38
39    private common _xp2obj       ;# used for fetch/release ref counting
40    private common _obj2ref      ;# used for fetch/release ref counting
41}
42
43# ----------------------------------------------------------------------
44# USAGE: Rappture::Cloud::fetch <xmlobj> <path>
45#
46# Clients use this instead of a constructor to fetch the Cloud for
47# a particular <path> in the <xmlobj>.  When the client is done with
48# the cloud, he calls "release" to decrement the reference count.
49# When the cloud is no longer needed, it is cleaned up automatically.
50# ----------------------------------------------------------------------
51itcl::body Rappture::Cloud::fetch {xmlobj path} {
52    set handle "$xmlobj|$path"
53    if {[info exists _xp2obj($handle)]} {
54        set obj $_xp2obj($handle)
55        incr _obj2ref($obj)
56        return $obj
57    }
58
59    set obj [Rappture::Cloud ::#auto $xmlobj $path]
60    set _xp2obj($handle) $obj
61    set _obj2ref($obj) 1
62    return $obj
63}
64
65# ----------------------------------------------------------------------
66# USAGE: Rappture::Cloud::release <obj>
67#
68# Clients call this when they're no longer using a Cloud fetched
69# previously by the "fetch" proc.  This decrements the reference
70# count for the cloud and destroys the object when it is no longer
71# in use.
72# ----------------------------------------------------------------------
73itcl::body Rappture::Cloud::release {obj} {
74    if {[info exists _obj2ref($obj)]} {
75        incr _obj2ref($obj) -1
76        if {$_obj2ref($obj) <= 0} {
77            unset _obj2ref($obj)
78            foreach handle [array names _xp2obj] {
79                if {$_xp2obj($handle) == $obj} {
80                    unset _xp2obj($handle)
81                }
82            }
83            itcl::delete object $obj
84        }
85    } else {
86        error "can't find reference count for $obj"
87    }
88}
89
90# ----------------------------------------------------------------------
91# CONSTRUCTOR
92# ----------------------------------------------------------------------
93itcl::body Rappture::Cloud::constructor {xmlobj path} {
94    if {![Rappture::library isvalid $xmlobj]} {
95        error "bad value \"$xmlobj\": should be Rappture::library"
96    }
97    set _xmlobj $xmlobj
98    set _cloud [$xmlobj element -as object $path]
99
100    set u [$_cloud get units]
101    if {"" != $u} {
102        while {[llength $u] < 3} {
103            lappend u [lindex $u end]
104        }
105        set _units $u
106    }
107
108    # create the vtk object containing points
109    vtkPoints $this-points
110
111    foreach lim {xmin xmax ymin ymax zmin zmax} {
112        set _limits($lim) ""
113    }
114
115    foreach line [split [$xmlobj get $path.points] \n] {
116        if {"" == [string trim $line]} {
117            continue
118        }
119
120        # make sure we have x,y,z
121        while {[llength $line] < 3} {
122            lappend line "0"
123        }
124
125        # extract each point and add it to the points list
126        foreach {x y z} $line break
127        foreach dim {x y z} units $_units {
128            set v [Rappture::Units::convert [set $dim] \
129                -context $units -to $units -units off]
130
131            set $dim $v  ;# save back to real x/y/z variable
132
133            if {"" == $_limits(${dim}min)} {
134                set _limits(${dim}min) $v
135                set _limits(${dim}max) $v
136            } else {
137                if {$v < $_limits(${dim}min)} { set _limits(${dim}min) $v }
138                if {$v > $_limits(${dim}max)} { set _limits(${dim}max) $v }
139            }
140        }
141        $this-points InsertNextPoint $x $y $z
142    }
143}
144
145# ----------------------------------------------------------------------
146# DESTRUCTOR
147# ----------------------------------------------------------------------
148itcl::body Rappture::Cloud::destructor {} {
149    # don't destroy the _xmlobj! we don't own it!
150    itcl::delete object $_cloud
151    rename $this-points ""
152}
153
154# ----------------------------------------------------------------------
155# USAGE: points
156#
157# Returns the vtk object containing the points for this mesh.
158# ----------------------------------------------------------------------
159itcl::body Rappture::Cloud::points {} {
160    return $this-points
161}
162
163# ----------------------------------------------------------------------
164# USAGE: mesh
165#
166# Returns the vtk object representing the mesh.
167# ----------------------------------------------------------------------
168itcl::body Rappture::Cloud::mesh {} {
169    return $this-points
170}
171
172# ----------------------------------------------------------------------
173# USAGE: size
174#
175# Returns the number of points in this cloud.
176# ----------------------------------------------------------------------
177itcl::body Rappture::Cloud::size {} {
178    return [$this-points GetNumberOfPoints]
179}
180
181# ----------------------------------------------------------------------
182# USAGE: dimensions
183#
184# Returns the number of dimensions for this object: 1, 2, or 3.
185# ----------------------------------------------------------------------
186itcl::body Rappture::Cloud::dimensions {} {
187    # count the dimensions with real limits
188    set dims 0
189    foreach d {x y z} {
190        if {$_limits(${d}min) != $_limits(${d}max)} {
191            incr dims
192        }
193    }
194    return $dims
195}
196
197# ----------------------------------------------------------------------
198# USAGE: limits x|y|z
199#
200# Returns the {min max} values for the limits of the specified axis.
201# ----------------------------------------------------------------------
202itcl::body Rappture::Cloud::limits {which} {
203    if {![info exists _limits(${which}min)]} {
204        error "bad axis \"$which\": should be x, y, z"
205    }
206    return [list $_limits(${which}min) $_limits(${which}max)]
207}
208
209# ----------------------------------------------------------------------
210# USAGE: hints ?<keyword>?
211#
212# Returns a list of key/value pairs for various hints about plotting
213# this field.  If a particular <keyword> is specified, then it returns
214# the hint for that <keyword>, if it exists.
215# ----------------------------------------------------------------------
216itcl::body Rappture::Cloud::hints {{keyword ""}} {
217    foreach key {label color units} {
218        set str [$_cloud get $key]
219        if {"" != $str} {
220            set hints($key) $str
221        }
222    }
223
224    if {$keyword != ""} {
225        if {[info exists hints($keyword)]} {
226            return $hints($keyword)
227        }
228        return ""
229    }
230    return [array get hints]
231}
Note: See TracBrowser for help on using the repository browser.