source: trunk/gui/scripts/unirect3d.tcl @ 1463

Last change on this file since 1463 was 1463, checked in by gah, 12 years ago
File size: 8.6 KB
Line 
1
2# ----------------------------------------------------------------------
3#  COMPONENT: unirect3d - represents a uniform rectangular 2-D mesh.
4#
5#  This object represents one field in an XML description of a device.
6#  It simplifies the process of extracting data vectors that represent
7#  the field.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2005  Purdue Research Foundation
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15package require Itcl
16package require BLT
17
18namespace eval Rappture { # forward declaration }
19
20itcl::class Rappture::Unirect3d {
21    constructor {xmlobj field cname} { # defined below }
22    destructor { # defined below }
23
24    public method limits {axis}
25    public method blob {}
26    public method mesh {}
27    public method values {}
28    public method hints {{keyword ""}}
29    public method order {} {
30        return _axisOrder;
31    }
32    public method components {} {
33        return _components;
34    }
35    private method GetString { obj path varName }
36    private method GetValue { obj path varName }
37    private method GetSize { obj path varName }
38
39    private variable _axisOrder  "x y z"
40    private variable _xMax       0
41    private variable _xMin       0
42    private variable _xNum       0
43    private variable _yMax       0
44    private variable _yMin       0
45    private variable _yNum       0
46    private variable _zMax       0
47    private variable _zMin       0
48    private variable _zNum       0
49    private variable _components 1
50    private variable _values     ""; # BLT vector containing the z-values
51    private variable _hints
52}
53
54# ----------------------------------------------------------------------
55# Constructor
56# ----------------------------------------------------------------------
57itcl::body Rappture::Unirect3d::constructor {xmlobj field cname} {
58    if {![Rappture::library isvalid $xmlobj]} {
59        error "bad value \"$xmlobj\": should be Rappture::library"
60    }
61    set path [$field get $cname.mesh]
62    set m [$xmlobj element -as object $path]
63    puts stderr [$m children]
64    GetValue $m "xaxis.max" _xMax
65    GetValue $m "xaxis.min" _xMin
66    GetValue $m "yaxis.max" _yMax
67    GetValue $m "yaxis.min" _yMin
68    GetValue $m "zaxis.max" _zMax
69    GetValue $m "zaxis.min" _zMin
70    GetSize $m "xaxis.numpoints" _xNum
71    GetSize $m "yaxis.numpoints" _yNum
72    GetSize $m "zaxis.numpoints" _zNum
73    GetSize $m "components" _components
74    itcl::delete object $m
75
76    set _values [blt::vector create #auto]
77    $_values set [$field get "$cname.values"]
78}
79
80# ----------------------------------------------------------------------
81# Destructor
82# ----------------------------------------------------------------------
83itcl::body Rappture::Unirect3d::destructor {} {
84    if { $_values != "" } {
85        blt::vector destroy $_values
86    }
87}
88
89# ----------------------------------------------------------------------
90# method blob
91#       Returns a base64 encoded, gzipped Tcl list that represents the
92#       Tcl command and data to recreate the uniform rectangular grid
93#       on the nanovis server.
94# ----------------------------------------------------------------------
95itcl::body Rappture::Unirect3d::blob {} {
96    lappend data "unirect3d"
97    lappend data "xmin" $_xMin "xmax" $_xMax "xnum" $_xNum
98    lappend data "ymin" $_yMin "ymax" $_yMax "ynum" $_yNum
99    lappend data "zmin" $_zMin "zmax" $_zMax "znum" $_zNum
100    lappend data "axisorder" $_axisOrder
101    lappend data "components" $_components
102    if { [$_values length] > 0 } {
103        lappend data "values" [$_values range 0 end]
104    }
105    return [Rappture::encoding::encode -as zb64 "$data"]
106}
107
108# ----------------------------------------------------------------------
109# method mesh
110#       Returns a base64 encoded, gzipped Tcl list that represents the
111#       Tcl command and data to recreate the uniform rectangular grid
112#       on the nanovis server.
113# ----------------------------------------------------------------------
114itcl::body Rappture::Unirect3d::mesh {} {
115    set dx [expr {($_xMax - $_xMin) / double($_xNum)}]
116    set dy [expr {($_yMax - $_yMin) / double($_yNum)}]
117    set dz [expr {($_zMax - $_zMin) / double($_zNum)}]
118    foreach {a b c} $_axisOrder break
119    for { set i 0 } { $i < [set _${a}Num] } { incr i } {
120        set v1 [expr {[set _${a}Min] + (double($i) * [set d${a}])}]
121        for { set j 0 } { $j < [set _${b}Num] } { incr j } {
122            set v2 [expr {[set _${b}Min] + (double($i) * [set d${b}])}]
123            for { set k 0 } { $k < [set _${c}Num] } { incr k } {
124                set v3 [expr {[set _${c}Min] + (double($i) * [set d${c}])}]
125                lappend data $v1 $v2 $v3
126            }
127        }
128    }
129    return $data
130}
131
132# ----------------------------------------------------------------------
133# method values
134#       Returns a base64 encoded, gzipped Tcl list that represents the
135#       Tcl command and data to recreate the uniform rectangular grid
136#       on the nanovis server.
137# ----------------------------------------------------------------------
138itcl::body Rappture::Unirect3d::values {} {
139    if { [$_values length] > 0 } {
140        return [$_values range 0 end]
141    }
142    return ""
143}
144
145# ----------------------------------------------------------------------
146# method limits <axis>
147#       Returns a list {min max} representing the limits for the
148#       specified axis.
149# ----------------------------------------------------------------------
150itcl::body Rappture::Unirect3d::limits {which} {
151    set min ""
152    set max ""
153
154    switch -- $which {
155        x - xlin - xlog {
156            set min $_xMin
157            set max $_xMax
158            set axis "xaxis"
159        }
160        y - ylin - ylog {
161            set min $_yMin
162            set max $_yMax
163            set axis "yaxis"
164        }
165        z - zlin - zlog {
166            set min $_zMin
167            set max $_zMax
168            set axis "zaxis"
169        }
170        v - vlin - vlog {
171            if { [$_values length] > 0 } {
172               set min [blt::vector expr min($_values)]
173               set max [blt::vector expr max($_values)]
174            } else {
175                set min 0.0
176                set max 1.0
177            }
178            set axis "vaxis"
179        }
180        default {
181            error "unknown axis description \"$which\""
182        }
183    }
184    return [list $min $max]
185}
186
187
188# ----------------------------------------------------------------------
189# USAGE: hints ?<keyword>?
190#
191# Returns a list of key/value pairs for various hints about plotting
192# this curve.  If a particular <keyword> is specified, then it returns
193# the hint for that <keyword>, if it exists.
194# ----------------------------------------------------------------------
195itcl::body Rappture::Unirect3d::hints {{keyword ""}} {
196    if {![info exists _hints]} {
197        foreach {key path} {
198            group   about.group
199            label   about.label
200            color   about.color
201            style   about.style
202            type    about.type
203            xlabel  xaxis.label
204            xdesc   xaxis.description
205            xunits  xaxis.units
206            xscale  xaxis.scale
207            ylabel  yaxis.label
208            ydesc   yaxis.description
209            yunits  yaxis.units
210            yscale  yaxis.scale
211            zlabel  zaxis.label
212            zdesc   zaxis.description
213            zunits  zaxis.units
214            zscale  zaxis.scale
215            order   about.axisorder
216        } {
217            set str [$_curve get $path]
218            if {"" != $str} {
219                set _hints($key) $str
220            }
221        }
222
223        if {[info exists _hints(xlabel)] && "" != $_hints(xlabel)
224              && [info exists _hints(xunits)] && "" != $_hints(xunits)} {
225            set _hints(xlabel) "$_hints(xlabel) ($_hints(xunits))"
226        }
227        if {[info exists _hints(ylabel)] && "" != $_hints(ylabel)
228              && [info exists _hints(yunits)] && "" != $_hints(yunits)} {
229            set _hints(ylabel) "$_hints(ylabel) ($_hints(yunits))"
230        }
231        if {[info exists _hints(zlabel)] && "" != $_hints(zlabel)
232              && [info exists _hints(zunits)] && "" != $_hints(zunits)} {
233            set _hints(ylabel) "$_hints(zlabel) ($_hints(zunits))"
234        }
235        if {[info exists _hints(group)] && [info exists _hints(label)]} {
236            # pop-up help for each curve
237            set _hints(tooltip) $_hints(label)
238        }
239    }
240    if {$keyword != ""} {
241        if {[info exists _hints($keyword)]} {
242            return $_hints($keyword)
243        }
244        return ""
245    }
246    return [array get _hints]
247}
248
249itcl::body Rappture::Unirect3d::GetSize { obj path varName } {
250    set string [$obj get $path]
251    if { [scan $string "%d" value] != 1 || $value < 0 } {
252        puts stderr "can't get size \"$string\" of \"$path\""
253        return
254    }
255    upvar $varName size
256    set size $value
257}
258
259itcl::body Rappture::Unirect3d::GetValue { obj path varName } {
260    set string [$obj get $path]
261    if { [scan $string "%g" value] != 1 } {
262        puts stderr "can't get value \"$string\" of \"$path\""
263        return
264    }
265    upvar $varName number
266    set number $value
267}
268
269itcl::body Rappture::Unirect3d::GetString { obj path varName } {
270    set string [$obj get $path]
271    if { $string == "" } {
272        puts stderr "can't get string \"$string\" of \"$path\""
273        return
274    }
275    upvar $varName str
276    set str $string
277}
Note: See TracBrowser for help on using the repository browser.