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

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