Ignore:
Timestamp:
Mar 18, 2009, 2:59:21 PM (16 years ago)
Author:
gah
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/tuples.tcl

    r115 r1342  
    3434    private common _counter 0      ;# for auto-generated column names
    3535}
    36                                                                                
     36                                                                               
    3737# ----------------------------------------------------------------------
    3838# CONSTRUCTOR
    … …  
    5757itcl::body Rappture::Tuples::column {option args} {
    5858    switch -- $option {
    59         insert {
    60             # parse the incoming args
    61             if {[llength $args] < 1} {
    62                 error "wrong # args: should be \"column insert pos ?-name n? ?-label l? ?-default v?\""
    63             }
    64             set pos [lindex $args 0]
    65             set args [lrange $args 1 end]
    66             Rappture::getopts args params {
    67                 value -name #auto
    68                 value -label ""
    69                 value -default ""
    70             }
    71             if {[llength $args] != 0} {
    72                 error "wrong # args: should be \"column insert pos ?-name n? ?-label l? ?-default v?\""
    73             }
    74 
    75             # insert the new column
    76             set cname $params(-name)
    77             if {$params(-name) == "#auto"} {
    78                 set cname "column[incr _counter]"
    79             }
    80             if {[lsearch -exact $_colnames $cname] >= 0} {
    81                 error "column name \"$cname\" already exists"
    82             }
    83             set _colnames [linsert $_colnames $pos $cname]
    84             set _col2info($cname-label) $params(-label)
    85             set _col2info($cname-default) $params(-default)
    86 
    87             # run through all existing tuples and insert the default val
    88             set max [array size _tuples]
    89             for {set i 0} {$i < $max} {incr i} {
    90                 set oldval $_tuples($i)
    91                 set _tuples($i) [linsert $oldval $pos $params(-default)]
    92             }
    93         }
    94         delete {
    95             foreach cname $args {
    96                 set pos [lsearch -exact $_colnames $cname]
    97                 if {$pos < 0} {
    98                     error "bad column name \"$cname\""
    99                 }
    100                 set _colnames [lreplace $_colnames $pos $pos]
    101                 unset _col2info($cname-label)
    102                 unset _col2info($cname-default)
    103 
    104                 # run through all existing tuples and delete the column
    105                 set max [array size _tuples]
    106                 for {set i 0} {$i < $max} {incr i} {
    107                     set oldval $_tuples($i)
    108                     set _tuples($i) [lreplace $oldval $pos $pos]
    109                 }
    110             }
    111         }
    112         names {
    113             if {[llength $args] == 0} {
    114                 return $_colnames
    115             } elseif {[llength $args] == 1} {
    116                 set pattern [lindex $args 0]
    117                 set rlist ""
    118                 foreach cname $_colnames {
    119                     if {[string match $pattern $cname]} {
    120                         lappend rlist $cname
    121                     }
    122                 }
    123                 return $rlist
    124             } else {
    125                 error "wrong # args: should be \"column names ?pattern?\""
    126             }
    127         }
    128         info {
    129             if {[llength $args] != 1} {
    130                 error "wrong # args: should be \"column info name\""
    131             }
    132             set cname [lindex $args 0]
    133             set pos [lsearch -exact $_colnames $cname]
    134             if {$pos < 0} {
    135                 error "bad column name \"$cname\""
    136             }
    137             return [list -label $_col2info($cname-label) -default $_col2info($cname-default)]
    138         }
    139         default {
    140             error "bad option \"$option\": should be delete, info, insert, names"
    141         }
     59        insert {
     60            # parse the incoming args
     61            if {[llength $args] < 1} {
     62                error "wrong # args: should be \"column insert pos ?-name n? ?-label l? ?-default v?\""
     63            }
     64            set pos [lindex $args 0]
     65            set args [lrange $args 1 end]
     66            Rappture::getopts args params {
     67                value -name #auto
     68                value -label ""
     69                value -default ""
     70            }
     71            if {[llength $args] != 0} {
     72                error "wrong # args: should be \"column insert pos ?-name n? ?-label l? ?-default v?\""
     73            }
     74
     75            # insert the new column
     76            set cname $params(-name)
     77            if {$params(-name) == "#auto"} {
     78                set cname "column[incr _counter]"
     79            }
     80            if {[lsearch -exact $_colnames $cname] >= 0} {
     81                error "column name \"$cname\" already exists"
     82            }
     83            set _colnames [linsert $_colnames $pos $cname]
     84            set _col2info($cname-label) $params(-label)
     85            set _col2info($cname-default) $params(-default)
     86
     87            # run through all existing tuples and insert the default val
     88            set max [array size _tuples]
     89            for {set i 0} {$i < $max} {incr i} {
     90                set oldval $_tuples($i)
     91                set _tuples($i) [linsert $oldval $pos $params(-default)]
     92            }
     93        }
     94        delete {
     95            foreach cname $args {
     96                set pos [lsearch -exact $_colnames $cname]
     97                if {$pos < 0} {
     98                    error "bad column name \"$cname\""
     99                }
     100                set _colnames [lreplace $_colnames $pos $pos]
     101                unset _col2info($cname-label)
     102                unset _col2info($cname-default)
     103
     104                # run through all existing tuples and delete the column
     105                set max [array size _tuples]
     106                for {set i 0} {$i < $max} {incr i} {
     107                    set oldval $_tuples($i)
     108                    set _tuples($i) [lreplace $oldval $pos $pos]
     109                }
     110            }
     111        }
     112        names {
     113            if {[llength $args] == 0} {
     114                return $_colnames
     115            } elseif {[llength $args] == 1} {
     116                set pattern [lindex $args 0]
     117                set rlist ""
     118                foreach cname $_colnames {
     119                    if {[string match $pattern $cname]} {
     120                        lappend rlist $cname
     121                    }
     122                }
     123                return $rlist
     124            } else {
     125                error "wrong # args: should be \"column names ?pattern?\""
     126            }
     127        }
     128        info {
     129            if {[llength $args] != 1} {
     130                error "wrong # args: should be \"column info name\""
     131            }
     132            set cname [lindex $args 0]
     133            set pos [lsearch -exact $_colnames $cname]
     134            if {$pos < 0} {
     135                error "bad column name \"$cname\""
     136            }
     137            return [list -label $_col2info($cname-label) -default $_col2info($cname-default)]
     138        }
     139        default {
     140            error "bad option \"$option\": should be delete, info, insert, names"
     141        }
    142142    }
    143143}
    … …  
    155155
    156156    if {"end" == $pos} {
    157         set pos $max
     157        set pos $max
    158158    } elseif {![string is integer $pos]} {
    159         error "bad position \"$pos\": should be integer or \"end\""
     159        error "bad position \"$pos\": should be integer or \"end\""
    160160    } elseif {$pos < 0} {
    161         set pos 0
     161        set pos 0
    162162    } elseif {$pos > $max} {
    163         set pos $max
     163        set pos $max
    164164    }
    165165
    … …  
    167167    set need [llength $args]
    168168    for {set i [expr {$max-1}]} {$i >= $pos} {incr i -1} {
    169         set _tuples([expr {$i+$need}]) $_tuples($i)
     169        set _tuples([expr {$i+$need}]) $_tuples($i)
    170170    }
    171171
    172172    # add the tuples at the specified pos
    173173    foreach t $args {
    174         # make sure each tuple has enough columns
    175         while {[llength $t] < $cols} {
    176             lappend t ""
    177         }
    178         set _tuples($pos) $t
    179         incr pos
     174        # make sure each tuple has enough columns
     175        while {[llength $t] < $cols} {
     176            lappend t ""
     177        }
     178        set _tuples($pos) $t
     179        incr pos
    180180    }
    181181}
    … …  
    191191itcl::body Rappture::Tuples::delete {{from ""} {to ""}} {
    192192    if {"" == $from && "" == $to} {
    193         catch {unset _tuples}
    194         return
     193        catch {unset _tuples}
     194        return
    195195    }
    196196    if {[array size _tuples] == 0} {
    197         return  ;# nothing to delete
     197        return  ;# nothing to delete
    198198    }
    199199
    … …  
    204204    set gap [expr {$to-$from+1}]
    205205    for {set i $from} {$i <= $last-$gap} {incr i} {
    206         set _tuples($i) $_tuples([expr {$i+$gap}])
     206        set _tuples($i) $_tuples([expr {$i+$gap}])
    207207    }
    208208    for {} {$i <= $last} {incr i} {
    209         unset _tuples($i)
     209        unset _tuples($i)
    210210    }
    211211}
    … …  
    223223itcl::body Rappture::Tuples::put {args} {
    224224    Rappture::getopts args params {
    225         value -format ""
     225        value -format ""
    226226    }
    227227    if {[llength $args] != 2} {
    228         error "wrong # args: should be \"put ?-format cols? pos tuple\""
     228        error "wrong # args: should be \"put ?-format cols? pos tuple\""
    229229    }
    230230    foreach {pos tuple} $args break
    … …  
    232232
    233233    if {![info exists _tuples($pos)]} {
    234         error "index $pos doesn't exist"
     234        error "index $pos doesn't exist"
    235235    }
    236236
    237237    if {[string length $params(-format)] == 0} {
    238         # no format -- add tuple as-is (with proper number of columns)
    239         set cols [llength $_colnames]
    240         while {[llength $tuple] < $cols} {
    241             lappend tuple ""
    242         }
    243         set _tuples($pos) $tuple
     238        # no format -- add tuple as-is (with proper number of columns)
     239        set cols [llength $_colnames]
     240        while {[llength $tuple] < $cols} {
     241            lappend tuple ""
     242        }
     243        set _tuples($pos) $tuple
    244244    } else {
    245         # convert column names to indices
    246         set nlist ""
    247         foreach cname $params(-format) {
    248             set n [lsearch -exact $_colnames $cname]
    249             if {$n < 0} {
    250                 error "bad column name \"$cname\""
    251             }
    252             lappend nlist $n
    253         }
    254 
    255         # convert data only for those indices
    256         set val $_tuples($pos)
    257         foreach n $nlist t $tuple {
    258             set val [lreplace $val $n $n $t]
    259         }
    260         set _tuples($pos) $val
     245        # convert column names to indices
     246        set nlist ""
     247        foreach cname $params(-format) {
     248            set n [lsearch -exact $_colnames $cname]
     249            if {$n < 0} {
     250                error "bad column name \"$cname\""
     251            }
     252            lappend nlist $n
     253        }
     254
     255        # convert data only for those indices
     256        set val $_tuples($pos)
     257        foreach n $nlist t $tuple {
     258            set val [lreplace $val $n $n $t]
     259        }
     260        set _tuples($pos) $val
    261261    }
    262262}
    … …  
    271271itcl::body Rappture::Tuples::get {args} {
    272272    Rappture::getopts args params {
    273         value -format ""
     273        value -format ""
    274274    }
    275275    if {[llength $args] > 2} {
    276         error "wrong # args: should be \"get ?-format cols? ?from? ?to?\""
     276        error "wrong # args: should be \"get ?-format cols? ?from? ?to?\""
    277277    }
    278278    set from ""
    … …  
    283283    # empty? then return nothing
    284284    if {[array size _tuples] == 0} {
    285         return ""
     285        return ""
    286286    }
    287287
    288288    set rlist ""
    289289    if {[string length $params(-format)] == 0} {
    290         # no format string -- return everything as-is
    291         for {set i $from} {$i <= $to} {incr i} {
    292             lappend rlist $_tuples($i)
    293         }
     290        # no format string -- return everything as-is
     291        for {set i $from} {$i <= $to} {incr i} {
     292            lappend rlist $_tuples($i)
     293        }
    294294    } else {
    295         # convert column names to indices
    296         set nlist ""
    297         foreach cname $params(-format) {
    298             set n [lsearch -exact $_colnames $cname]
    299             if {$n < 0} {
    300                 error "bad column name \"$cname\""
    301             }
    302             lappend nlist $n
    303         }
    304         set single [expr {[llength $nlist] == 1}]
    305 
    306         # convert data only for those indices
    307         for {set i $from} {$i <= $to} {incr i} {
    308             set t ""
    309             foreach n $nlist {
    310                 if {$single} {
    311                     set t [lindex $_tuples($i) $n]
    312                 } else {
    313                     lappend t [lindex $_tuples($i) $n]
    314                 }
    315             }
    316             lappend rlist $t
    317         }
     295        # convert column names to indices
     296        set nlist ""
     297        foreach cname $params(-format) {
     298            set n [lsearch -exact $_colnames $cname]
     299            if {$n < 0} {
     300                error "bad column name \"$cname\""
     301            }
     302            lappend nlist $n
     303        }
     304        set single [expr {[llength $nlist] == 1}]
     305
     306        # convert data only for those indices
     307        for {set i $from} {$i <= $to} {incr i} {
     308            set t ""
     309            foreach n $nlist {
     310                if {$single} {
     311                    set t [lindex $_tuples($i) $n]
     312                } else {
     313                    lappend t [lindex $_tuples($i) $n]
     314                }
     315            }
     316            lappend rlist $t
     317        }
    318318    }
    319319    return $rlist
    … …  
    332332itcl::body Rappture::Tuples::find {args} {
    333333    Rappture::getopts args params {
    334         value -format ""
     334        value -format ""
    335335    }
    336336    if {[llength $args] > 1} {
    337         error "wrong # args: should be \"find ?-format cols? ?tuple?\""
     337        error "wrong # args: should be \"find ?-format cols? ?tuple?\""
    338338    }
    339339
    … …  
    341341    set nlist ""
    342342    foreach cname $params(-format) {
    343         set n [lsearch -exact $_colnames $cname]
    344         if {$n < 0} {
    345             error "bad column name \"$cname\""
    346         }
    347         lappend nlist $n
     343        set n [lsearch -exact $_colnames $cname]
     344        if {$n < 0} {
     345            error "bad column name \"$cname\""
     346        }
     347        lappend nlist $n
    348348    }
    349349
    … …  
    352352    set last [expr {[array size _tuples]-1}]
    353353    if {[llength $args] == 0} {
    354         # no tuple? then all match
    355         for {set i 0} {$i <= $last} {incr i} {
    356             lappend rlist $i
    357         }
     354        # no tuple? then all match
     355        for {set i 0} {$i <= $last} {incr i} {
     356            lappend rlist $i
     357        }
    358358    } else {
    359         set tuple [lindex $args 0]
    360         if {[llength $nlist] == 0} {
    361             # no format? then look for an exact match
    362             for {set i 0} {$i <= $last} {incr i} {
    363                 if {[string equal $tuple $_tuples($i)]} {
    364                     lappend rlist $i
    365                 }
    366             }
    367         } else {
    368             # match only the columns in the -format
    369             for {set i 0} {$i <= $last} {incr i} {
    370                 set matching 1
    371                 foreach n $nlist t $tuple {
    372                     set val [lindex $_tuples($i) $n]
    373                     if {![string equal $t $val]} {
    374                         set matching 0
    375                         break
    376                     }
    377                 }
    378                 if {$matching} {
    379                     lappend rlist $i
    380                 }
    381             }
    382         }
     359        set tuple [lindex $args 0]
     360        if {[llength $nlist] == 0} {
     361            # no format? then look for an exact match
     362            for {set i 0} {$i <= $last} {incr i} {
     363                if {[string equal $tuple $_tuples($i)]} {
     364                    lappend rlist $i
     365                }
     366            }
     367        } else {
     368            # match only the columns in the -format
     369            for {set i 0} {$i <= $last} {incr i} {
     370                set matching 1
     371                foreach n $nlist t $tuple {
     372                    set val [lindex $_tuples($i) $n]
     373                    if {![string equal $t $val]} {
     374                        set matching 0
     375                        break
     376                    }
     377                }
     378                if {$matching} {
     379                    lappend rlist $i
     380                }
     381            }
     382        }
    383383    }
    384384    return $rlist
    … …  
    406406    set last [expr {[array size _tuples]-1}]
    407407    if {"" == $from && "" == $to} {
    408         return [list 0 $last]
     408        return [list 0 $last]
    409409    }
    410410
    411411    if {"end" == $from} {
    412         set from $last
     412        set from $last
    413413    } elseif {![string is integer $from]} {
    414         error "bad position \"$from\": should be integer or \"end\""
     414        error "bad position \"$from\": should be integer or \"end\""
    415415    }
    416416    if {$from < 0} {
    417         set from 0
     417        set from 0
    418418    } elseif {$from > $last} {
    419         set from $last
     419        set from $last
    420420    }
    421421
    422422    if {"" == $to} {
    423         set to $from
     423        set to $from
    424424    } elseif {"end" == $to} {
    425         set to $last
     425        set to $last
    426426    } elseif {![string is integer $to]} {
    427         error "bad position \"$to\": should be integer or \"end\""
     427        error "bad position \"$to\": should be integer or \"end\""
    428428    }
    429429    if {$to < 0} {
    430         set to 0
     430        set to 0
    431431    } elseif {$to > $last} {
    432         set to $last
     432        set to $last
    433433    }
    434434
    435435    if {$from > $to} {
    436         # make sure to/from are in proper order
    437         set tmp $from
    438         set from $to
    439         set to $tmp
     436        # make sure to/from are in proper order
     437        set tmp $from
     438        set from $to
     439        set to $tmp
    440440    }
    441441    return [list $from $to]
Note: See TracChangeset for help on using the changeset viewer.