1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
# Copyright (C) 1999-2018
# Smithsonian Astrophysical Observatory, Cambridge, MA, USA
# For conditions of distribution and use, see copyright notice in "copyright"
package provide DS9 1.0
proc CATFltSort {varname} {
upvar #0 $varname var
global $varname
global $var(catdb)
global $var(tbldb)
upvar #0 $var(catdb) catsrc
upvar #0 $var(tbldb) catdest
# create header
set catdest(Header) $catsrc(Header)
starbase_colmap catdest
set catdest(Ndshs) [llength $catdest(Header)]
set catdest(Nrows) 0
set catdest(HLines) $catsrc(HLines)
set catdest(Dashes) $catsrc(Dashes)
# optional
if {[info exists catsrc(DataType)]} {
set catdest(DataType) $catsrc(DataType)
}
if {[info exists catsrc(Id)]} {
set catdest(Id) $catsrc(Id)
}
if {[info exists catsrc(ArraySize)]} {
set catdest(ArraySize) $catsrc(ArraySize)
}
if {[info exists catsrc(Width)]} {
set catdest(Width) $catsrc(Width)
}
if {[info exists catsrc(Precision)]} {
set catdest(Precision) $catsrc(Precision)
}
if {[info exists catsrc(Unit)]} {
set catdest(Unit) $catsrc(Unit)
}
if {[info exists catsrc(Ref)]} {
set catdest(Ref) $catsrc(Ref)
}
if {[info exists catsrc(Ucd)]} {
set catdest(Ucd) $catsrc(Ucd)
}
if {[info exists catsrc(Description)]} {
set catdest(Description) $catsrc(Description)
}
for {set ii 1} {$ii<=$catsrc(HLines)} {incr ii} {
set catdest(H_$ii) $catsrc(H_$ii)
}
for {set jj 1} {$jj<=$catsrc(Ncols)} {incr jj} {
set catdest(0,$jj) $catsrc(0,$jj)
}
# sort?
set order {}
if {$var(sort) != {}} {
set col $catsrc($var(sort))
for {set ii 1} {$ii<=$catsrc(Nrows)} {incr ii} {
set val $catsrc($ii,$col)
# if blank, set to 0
if {$val == {}} {
set val 0
}
lappend order "[list $ii $val]"
}
# first try as real, if error, then ascii
if {[catch {lsort $var(sort,dir) -real -index 1 $order} oo]} {
set oo [lsort $var(sort,dir) -ascii -index 1 $order]
}
set order $oo
} else {
for {set ii 1} {$ii<=$catsrc(Nrows)} {incr ii} {
lappend order "[list $ii {}]"
}
}
# data
set kk 0
for {set ii 1} {$ii<=$catsrc(Nrows)} {incr ii} {
set id [lindex [lindex $order [expr $ii-1]] 0]
# now filter
set pass 1
if {$var(filter) != {}} {
# eval all colnames
foreach col $catsrc(Header) {
set col [string trim $col]
set val $catsrc($id,$catsrc($col))
# here's a tough one--
# what to do if the column is blank
# for now, just set it to '0'
if {[string trim "$val"] == {}} {
set val 0
}
eval "set \{$col\} \{$val\}"
}
# subst any columv vars
if {[catch {subst $var(filter)} ff]} {
return 0
}
# evaluate filter
if {[catch {expr $ff} result]} {
return 0
}
# do we keep the row?
if {!$result} {
set pass 0
}
}
if {$pass} {
incr kk
for {set jj 1} {$jj<=$catsrc(Ncols)} {incr jj} {
set catdest($kk,$jj) $catsrc($id,$jj)
}
}
}
# success
set catdest(Nrows) $kk
return 1
}
|
