source: branches/r9/gui/scripts/drawing.tcl @ 4919

Last change on this file since 4919 was 4919, checked in by gah, 6 years ago
File size: 7.5 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: drawing - 3D drawing of data
4# ======================================================================
5#  AUTHOR:  Michael McLennan, Purdue University
6#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
7#
8#  See the file "license.terms" for information on usage and
9#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10# ======================================================================
11package require Itcl
12package require BLT
13
14namespace eval Rappture {
15    # forward declaration
16}
17
18itcl::class Rappture::Drawing {
19    private variable _drawing
20    private variable _xmlobj
21    private variable _styles
22    private variable _shapes
23    private variable _labels
24    private variable _types
25    private variable _data
26    private variable _hints
27    private variable _units
28
29    constructor {xmlobj path} {
30        # defined below
31    }
32    destructor {
33        # defined below
34    }
35
36    public method label { elem }
37    public method type { elem }
38    public method style { elem }
39    public method shape { elem }
40    public method values { elem }
41    public method data { elem }
42    public method hints {{keyword ""}}
43    public method components { args }
44}
45
46# ----------------------------------------------------------------------
47# Constructor
48# ----------------------------------------------------------------------
49itcl::body Rappture::Drawing::constructor {xmlobj path} {
50    package require vtk
51    if {![Rappture::library isvalid $xmlobj]} {
52        error "bad value \"$xmlobj\": should be Rappture::library"
53    }
54    set _xmlobj $xmlobj
55    set _drawing [$xmlobj element -as object $path]
56    set _units [$_drawing get units]
57
58    set xunits [$xmlobj get units]
59    if {"" == $xunits || "arbitrary" == $xunits} {
60        set xunits "um"
61    }
62    # determine the overall size of the device
63    foreach elem [$_xmlobj children $path] {
64        switch -glob -- $elem {
65            # polygon is deprecated in favor of polydata
66            polygon* - polydata* {
67                set _data($elem) [$_xmlobj get $path.$elem.vtk]
68                set _data($elem) [string trim $_data($elem)]
69                set _styles($elem) [$_xmlobj get $path.$elem.about.style]
70                set _labels($elem) [$_xmlobj get $path.$elem.about.label]
71                set _types($elem) polydata
72            }
73            glyphs* {
74                set _data($elem) [$_xmlobj get $path.$elem.vtk]
75                set _data($elem) [string trim $_data($elem)]
76                set _styles($elem) [$_xmlobj get $path.$elem.about.style]
77                set _labels($elem) [$_xmlobj get $path.$elem.about.label]
78                set _shapes($elem) [$_xmlobj get $path.$elem.about.shape]
79                set _types($elem) glyphs
80            }
81            molecule* {
82                set pdbdata [$_xmlobj get $path.$elem.pdb]
83                if { $pdbdata != "" } {
84                    set contents [Rappture::PdbToVtk $pdbdata]
85                } else {
86                    set contents [$_xmlobj get $path.$elem.vtk]
87                }
88                set _data($elem) [string trim $contents]
89                set _styles($elem) [$_xmlobj get $path.$elem.about.style]
90                set _labels($elem) [$_xmlobj get $path.$elem.about.label]
91                set _types($elem) molecule
92            }
93        }
94    }
95    foreach {key path} {
96        group   about.group
97        label   about.label
98        color   about.color
99        camera  about.camera
100        type    about.type
101        xlabel  xaxis.label
102        xdesc   xaxis.description
103        xunits  xaxis.units
104        xscale  xaxis.scale
105        xmin    xaxis.min
106        xmax    xaxis.max
107        ylabel  yaxis.label
108        ydesc   yaxis.description
109        yunits  yaxis.units
110        yscale  yaxis.scale
111        ymin    yaxis.min
112        ymax    yaxis.max
113        zlabel  zaxis.label
114        zdesc   zaxis.description
115        zunits  zaxis.units
116        zscale  zaxis.scale
117        zmin    zaxis.min
118        zmax    zaxis.max
119    } {
120        set str [$_drawing get $path]
121        if {"" != $str} {
122            set _hints($key) $str
123        }
124    }
125    foreach {key} { axisorder } {
126        set str [$_drawing get $key]
127        if {"" != $str} {
128            set _hints($key) $str
129        }
130    }
131}
132
133# ----------------------------------------------------------------------
134# Destructor
135# ----------------------------------------------------------------------
136itcl::body Rappture::Drawing::destructor {} {
137    # empty
138}
139
140#
141# label --
142#
143#       Returns the label of the named drawing element.
144#
145itcl::body Rappture::Drawing::label { elem } {
146    if { [info exists _labels($elem)] } {
147        return $_labels($elem)
148    }
149    return ""
150}
151
152#
153# type --
154#
155#       Returns the type of the named drawing element.
156#
157itcl::body Rappture::Drawing::type { elem } {
158    if { [info exists _types($elem)] } {
159        return $_types($elem)
160    }
161    return ""
162}
163
164#
165# style --
166#
167#       Returns the style string of the named drawing element.
168#
169itcl::body Rappture::Drawing::style { elem } {
170    if { [info exists _styles($elem)] } {
171        return $_styles($elem)
172    }
173    return ""
174}
175
176#
177# shape --
178#
179#       Returns the shape of the glyphs in the drawing element.
180#
181itcl::body Rappture::Drawing::shape { elem } {
182    set shape ""
183    if { [info exists _shapes($elem)] } {
184        return $_shapes($elem)
185    }
186    switch -- $shape {
187        arrow - cone - cube - cylinder - dodecahedron -
188        icosahedron - line - octahedron - sphere - tetrahedron  {
189            return $shape
190        }
191        default {
192            puts stderr "unknown glyph shape \"$shape\""
193        }
194    }
195    return ""
196}
197
198#
199# data --
200#
201#       Returns the data of the named drawing element.
202#
203itcl::body Rappture::Drawing::data { elem } {
204    if { [info exists _data($elem)] } {
205        return $_data($elem)
206    }
207    return ""
208}
209
210# ----------------------------------------------------------------------
211# method values
212#       Returns a base64 encoded, gzipped Tcl list that represents the
213#       Tcl command and data to recreate the uniform rectangular grid
214#       on the nanovis server.
215# ----------------------------------------------------------------------
216itcl::body Rappture::Drawing::values { elem } {
217    if { [info exists _data($elem)] } {
218        return $_data($elem)
219    }
220    return ""
221}
222
223itcl::body Rappture::Drawing::components { args } {
224    return [array names _data]
225}
226
227# ----------------------------------------------------------------------
228# USAGE: hints ?<keyword>?
229#
230# Returns a list of key/value pairs for various hints about plotting
231# this curve.  If a particular <keyword> is specified, then it returns
232# the hint for that <keyword>, if it exists.
233# ----------------------------------------------------------------------
234itcl::body Rappture::Drawing::hints { {keyword ""} } {
235    if 0 {
236    if {[info exists _hints(xlabel)] && "" != $_hints(xlabel)
237        && [info exists _hints(xunits)] && "" != $_hints(xunits)} {
238        set _hints(xlabel) "$_hints(xlabel) ($_hints(xunits))"
239    }
240    if {[info exists _hints(ylabel)] && "" != $_hints(ylabel)
241        && [info exists _hints(yunits)] && "" != $_hints(yunits)} {
242        set _hints(ylabel) "$_hints(ylabel) ($_hints(yunits))"
243    }
244    }
245    if {[info exists _hints(group)] && [info exists _hints(label)]} {
246        # pop-up help for each curve
247        set _hints(tooltip) $_hints(label)
248    }
249    if {$keyword != ""} {
250        if {[info exists _hints($keyword)]} {
251            return $_hints($keyword)
252        }
253        return ""
254    }
255    return [array get _hints]
256}
Note: See TracBrowser for help on using the repository browser.