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

Last change on this file since 1111 was 1111, checked in by gah, 16 years ago

nanovis/heightmap update

File size: 7.3 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: unirect2d - represents a uniform rectangular 2-D mesh.
3#
4#  This object represents one field in an XML description of a device.
5#  It simplifies the process of extracting data vectors that represent
6#  the field.
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 BLT
16
17namespace eval Rappture { # forward declaration }
18
19itcl::class Rappture::UniRect2d {
20    constructor {xmlobj field cname} { # defined below }
21    destructor { # defined below }
22
23    public method limits {axis}
24    public method blob {}
25    public method mesh {}
26    public method values {}
27    public method hints {{keyword ""}}
28
29    private variable _xmax 0
30    private variable _xmin 0
31    private variable _xnum 0
32    private variable _ymax 0
33    private variable _ymin 0
34    private variable _ynum 0
35    private variable _zv "";            # BLT vector containing the z-values
36    private variable _hints
37}
38
39# ----------------------------------------------------------------------
40# Constructor
41# ----------------------------------------------------------------------
42itcl::body Rappture::UniRect2d::constructor {xmlobj field cname} {
43    if {![Rappture::library isvalid $xmlobj]} {
44        error "bad value \"$xmlobj\": should be Rappture::library"
45    }
46    set path [$field get $cname.mesh]
47
48    set mobj [$xmlobj element -as object $path]
49    set _xmin [$mobj get "xaxis.min"]
50    set _xmax [$mobj get "xaxis.max"]
51    set _xnum [$mobj get "xaxis.numpoints"]
52    set _ymin [$mobj get "yaxis.min"]
53    set _ymax [$mobj get "yaxis.max"]
54    set _ynum [$mobj get "yaxis.numpoints"]
55    itcl::delete object $mobj
56
57    set _zv [blt::vector create #auto]
58    $_zv set [$field get "$cname.values"]
59}
60
61# ----------------------------------------------------------------------
62# Destructor
63# ----------------------------------------------------------------------
64itcl::body Rappture::UniRect2d::destructor {} {
65    if { $_zv != "" } {
66        blt::vector destroy $_zv
67    }
68}
69
70# ----------------------------------------------------------------------
71# method blob
72#       Returns a base64 encoded, gzipped Tcl list that represents the
73#       Tcl command and data to recreate the uniform rectangular grid
74#       on the nanovis server.
75# ----------------------------------------------------------------------
76itcl::body Rappture::UniRect2d::blob {} {
77    set data "unirect2d"
78    lappend data "xmin" $_xmin "xmax" $_xmax "xnum" $_xnum
79    lappend data "ymin" $_ymin "ymax" $_ymax "ynum" $_ynum
80    lappend data "xmin" $_xmin "ymin" $_ymin "xmax" $_xmax "ymax" $_ymax
81    if { [$_zv length] > 0 } {
82        lappend data "zvalues" [$_zv range 0 end]
83    }
84    return [Rappture::encoding::encode -as zb64 $data]
85}
86
87# ----------------------------------------------------------------------
88# method mesh
89#       Returns a base64 encoded, gzipped Tcl list that represents the
90#       Tcl command and data to recreate the uniform rectangular grid
91#       on the nanovis server.
92# ----------------------------------------------------------------------
93itcl::body Rappture::UniRect2d::mesh {} {
94    set dx [expr {($_xmax - $_xmin) / double($_xnum)}]
95    set dy [expr {($_ymax - $_ymin) / double($_ynum)}]
96    for { set i 0 } { $i < $_xnum } { incr i } {
97        set x [expr {$_xmin + (double($i) * $dx)}]
98        for { set j 0 } { $j < $_ynum } { incr j } {
99            set y [expr {$_ymin + (double($i) * $dy)}]
100            lappend data $x $y
101        }
102    }
103    return $data
104}
105
106# ----------------------------------------------------------------------
107# method values
108#       Returns a base64 encoded, gzipped Tcl list that represents the
109#       Tcl command and data to recreate the uniform rectangular grid
110#       on the nanovis server.
111# ----------------------------------------------------------------------
112itcl::body Rappture::UniRect2d::values {} {
113    if { [$_zv length] > 0 } {
114        return [$_zv range 0 end]
115    }
116    return ""
117}
118
119# ----------------------------------------------------------------------
120# method limits <axis>
121#       Returns a list {min max} representing the limits for the
122#       specified axis.
123# ----------------------------------------------------------------------
124itcl::body Rappture::UniRect2d::limits {which} {
125    set min ""
126    set max ""
127
128    switch -- $which {
129        x - xlin - xlog {
130            set min $_xmin
131            set max $_xmax
132            set axis "xaxis"
133        }
134        y - ylin - ylog {
135            set min $_ymin
136            set max $_ymax
137            set axis "yaxis"
138        }
139        v - xlin - vlog - z - zlin - zlog {
140            if { [$_zv length] > 0 } {
141               set min [blt::vector expr min($_zv)]
142               set max [blt::vector expr max($_zv)]
143            } else {
144                set min 0.0
145                set max 1.0
146            }
147            set axis "zaxis"
148        }
149        default {
150            error "unknown axis description \"$which\""
151        }
152    }
153#     set val [$_field get $axis.min]
154#     if {"" != $val && "" != $min} {
155#         if {$val > $min} {
156#             # tool specified this min -- don't go any lower
157#             set min $val
158#         }
159#     }
160#     set val [$_field get $axis.max]
161#     if {"" != $val && "" != $max} {
162#         if {$val < $max} {
163#             # tool specified this max -- don't go any higher
164#             set max $val
165#         }
166#     }
167
168    return [list $min $max]
169}
170
171
172# ----------------------------------------------------------------------
173# USAGE: hints ?<keyword>?
174#
175# Returns a list of key/value pairs for various hints about plotting
176# this curve.  If a particular <keyword> is specified, then it returns
177# the hint for that <keyword>, if it exists.
178# ----------------------------------------------------------------------
179itcl::body Rappture::UniRect2d::hints {{keyword ""}} {
180    if {![info exists _hints]} {
181        foreach {key path} {
182            group   about.group
183            label   about.label
184            color   about.color
185            style   about.style
186            type    about.type
187            xlabel  xaxis.label
188            xdesc   xaxis.description
189            xunits  xaxis.units
190            xscale  xaxis.scale
191            xmin    xaxis.min
192            xmax    xaxis.max
193            ylabel  yaxis.label
194            ydesc   yaxis.description
195            yunits  yaxis.units
196            yscale  yaxis.scale
197            ymin    yaxis.min
198            ymax    yaxis.max
199        } {
200            set str [$_curve get $path]
201            if {"" != $str} {
202                set _hints($key) $str
203            }
204        }
205
206        if {[info exists _hints(xlabel)] && "" != $_hints(xlabel)
207              && [info exists _hints(xunits)] && "" != $_hints(xunits)} {
208            set _hints(xlabel) "$_hints(xlabel) ($_hints(xunits))"
209        }
210        if {[info exists _hints(ylabel)] && "" != $_hints(ylabel)
211              && [info exists _hints(yunits)] && "" != $_hints(yunits)} {
212            set _hints(ylabel) "$_hints(ylabel) ($_hints(yunits))"
213        }
214
215        if {[info exists _hints(group)] && [info exists _hints(label)]} {
216            # pop-up help for each curve
217            set _hints(tooltip) $_hints(label)
218        }
219    }
220
221    if {$keyword != ""} {
222        if {[info exists _hints($keyword)]} {
223            return $_hints($keyword)
224        }
225        return ""
226    }
227    return [array get _hints]
228}
Note: See TracBrowser for help on using the repository browser.