source: trunk/gui/scripts/table.tcl @ 1394

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

preliminary HQ output from molvisviewer; unexpand tabs; all jpeg generation at 100%

File size: 6.9 KB
RevLine 
[11]1# ----------------------------------------------------------------------
2#  COMPONENT: table - extracts data from an XML description of a table
3#
[13]4#  This object represents one table in an XML description of a table.
[11]5#  It simplifies the process of extracting data representing columns
6#  in the table.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
[115]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.
[11]13# ======================================================================
14package require Itcl
15
16namespace eval Rappture { # forward declaration }
17
18itcl::class Rappture::Table {
[13]19    constructor {xmlobj path} { # defined below }
[11]20    destructor { # defined below }
21
22    public method rows {}
[13]23    public method columns {args}
24    public method values {args}
25    public method limits {col}
[11]26    public method hints {{key ""}}
27
[13]28    private variable _xmlobj ""  ;# ref to lib obj with curve data
[11]29    private variable _table ""   ;# lib obj representing this table
[13]30    private variable _tuples ""  ;# list of tuples with table data
[11]31}
32
33# ----------------------------------------------------------------------
34# CONSTRUCTOR
35# ----------------------------------------------------------------------
[13]36itcl::body Rappture::Table::constructor {xmlobj path} {
37    if {![Rappture::library isvalid $xmlobj]} {
[1342]38        error "bad value \"$xmlobj\": should be Rappture::library"
[11]39    }
[13]40    set _table [$xmlobj element -as object $path]
[11]41
[13]42    #
43    # Load data from the table and store in the tuples.
44    #
45    set _tuples [Rappture::Tuples ::#auto]
46    foreach cname [$_table children -type column] {
[1342]47        set label [$_table get $cname.label]
48        $_tuples column insert end -name $cname -label $label
[13]49    }
[11]50
[13]51    set cols [llength [$_tuples column names]]
52    set nline 1
53    foreach line [split [$_table get data] \n] {
[1342]54        if {[llength $line] == 0} {
55            continue
56        }
57        if {[llength $line] != $cols} {
58            error "bad data at line $nline: expected $cols columns but got \"[string trim $line]\""
59        }
60        $_tuples insert end $line
61        incr nline
[11]62    }
63}
64
65# ----------------------------------------------------------------------
66# DESTRUCTOR
67# ----------------------------------------------------------------------
68itcl::body Rappture::Table::destructor {} {
[13]69    itcl::delete object $_tuples
[11]70    itcl::delete object $_table
[13]71    # don't destroy the _xmlobj! we don't own it!
72}
[11]73
[13]74# ----------------------------------------------------------------------
75# USAGE: rows
76#
77# Returns the number of rows of information in this table.
78# ----------------------------------------------------------------------
79itcl::body Rappture::Table::rows {} {
80    return [$_tuples size]
[11]81}
82
83# ----------------------------------------------------------------------
[13]84# USAGE: columns ?-component|-label|-units? ?<pos>?
[11]85#
[13]86# Returns information about the columns associated with this table.
[11]87# ----------------------------------------------------------------------
[13]88itcl::body Rappture::Table::columns {args} {
89    Rappture::getopts args params {
[1342]90        flag switch -component
91        flag switch -label default
92        flag switch -units
[13]93    }
94    if {[llength $args] == 0} {
[1342]95        set cols [llength [$_tuples column names]]
96        set plist ""
97        for {set i 0} {$i < $cols} {incr i} {
98            lappend plist $i
99        }
[13]100    } elseif {[llength $args] == 1} {
[1342]101        set p [lindex $args 0]
102        if {[string is integer $p]} {
103            lappend plist $p
104        } else {
105            set pos [lsearch -exact [$_tuples column names] $p]
106            if {$pos < 0} {
107                error "bad column \"$p\": should be column name or integer index"
108            }
109            lappend plist $pos
110        }
[13]111    } else {
[1342]112        error "wrong # args: should be \"columns ?-component|-label|-units? ?pos?\""
[13]113    }
114
[11]115    set rlist ""
[13]116    switch -- $params(switch) {
[1342]117        -component {
118            set names [$_tuples column names]
119            foreach p $plist {
120                lappend rlist [lindex $names $p]
121            }
122        }
123        -label {
124            set names [$_tuples column names]
125            foreach p $plist {
126                set name [lindex $names $p]
127                catch {unset opts}
128                array set opts [$_tuples column info $name]
129                lappend rlist $opts(-label)
130            }
131        }
132        -units {
133            set names [$_tuples column names]
134            foreach p $plist {
135                set comp [lindex $names $p]
136                lappend rlist [$_table get $comp.units]
137            }
138        }
[11]139    }
140    return $rlist
141}
142
143# ----------------------------------------------------------------------
[13]144# USAGE: values ?-row <index>? ?-column <index>?
[11]145#
[13]146# Returns a single value or a list of values for data in this table.
147# If a particular -row and -column is specified, then it returns
148# a single value for that row/column.  If either the -row or the
149# -column is specified, then it returns a list of values in that
150# row or column.  With no args, it returns all values in the table.
[11]151# ----------------------------------------------------------------------
[13]152itcl::body Rappture::Table::values {args} {
153    Rappture::getopts args params {
[1342]154        value -row ""
155        value -column ""
[11]156    }
[13]157    if {[llength $args] > 0} {
[1342]158        error "wrong # args: should be \"values ?-row r? ?-column c?\""
[13]159    }
160    if {"" == $params(-row) && "" == $params(-column)} {
[1342]161        return [$_tuples get]
[13]162    } elseif {"" == $params(-column)} {
[1342]163        return [lindex [$_tuples get $params(-row)] 0]
[13]164    }
165
166    if {[string is integer $params(-column)]} {
[1342]167        set col [lindex [$_tuples column names] $params(-column)]
[13]168    } else {
[1342]169        set col $params(-column)
170        if {"" == [$_tuples column names $col]} {
171            error "bad column name \"$col\": should be [join [$_tuples column names] {, }]"
172        }
[13]173    }
174
175    if {"" == $params(-row)} {
[1342]176        # return entire column
177        return [$_tuples get -format $col]
[13]178    }
179    # return a particular cell
180    return [$_tuples get -format $col $params(-row)]
[11]181}
182
183# ----------------------------------------------------------------------
[13]184# USAGE: limits <column>
185#
186# Returns the {min max} limits of the numerical values in the
187# specified <column>, which can be either an integer index to
188# a column or a column name.
189# ----------------------------------------------------------------------
190itcl::body Rappture::Table::limits {column} {
191    set min ""
192    set max ""
193    foreach v [values -column $column] {
[1342]194        if {"" == $min} {
195            set min $v
196            set max $v
197        } else {
198            if {$v < $min} { set min $v }
199            if {$v > $max} { set max $v }
200        }
[13]201    }
202    return [list $min $max]
203}
204
205# ----------------------------------------------------------------------
[11]206# USAGE: hints ?<keyword>?
207#
208# Returns a list of key/value pairs for various hints about plotting
209# this table.  If a particular <keyword> is specified, then it returns
210# the hint for that <keyword>, if it exists.
211# ----------------------------------------------------------------------
212itcl::body Rappture::Table::hints {{keyword ""}} {
[13]213    foreach {key path} {
[1342]214        label   about.label
215        color   about.color
216        style   about.style
[13]217    } {
[1342]218        set str [$_table get $path]
219        if {"" != $str} {
220            set hints($key) $str
221        }
[11]222    }
223
224    if {$keyword != ""} {
[1342]225        if {[info exists hints($keyword)]} {
226            return $hints($keyword)
227        }
228        return ""
[11]229    }
230    return [array get hints]
231}
Note: See TracBrowser for help on using the repository browser.