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

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