blob: 794677f5a371c772fdbc00c0134c4e931a6ae488 (
plain)
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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
load ./libsqlite3.dylib
#package require sqlite3
source [file join [file dirname $argv0] rtree_util.tcl]
wm title . "SQLite r-tree viewer"
if {[llength $argv]!=1} {
puts stderr "Usage: $argv0 <database-file>"
puts stderr ""
exit
}
sqlite3 db [lindex $argv 0]
canvas .c -background white -width 400 -height 300 -highlightthickness 0
button .b -text "Parent Node" -command {
set sql "SELECT parentnode FROM $::O(zTab)_parent WHERE nodeno = $::O(iNode)"
set ::O(iNode) [db one $sql]
if {$::O(iNode) eq ""} {set ::O(iNode) 1}
view_node
}
set O(iNode) 1
set O(zTab) ""
set O(listbox_captions) [list]
set O(listbox_itemmap) [list]
set O(listbox_highlight) -1
listbox .l -listvariable ::O(listbox_captions) -yscrollcommand {.ls set}
scrollbar .ls -command {.l yview}
label .status -font courier -anchor w
label .title -anchor w -text "Node 1:" -background white -borderwidth 0
set rtree_tables [list]
db eval {
SELECT name
FROM sqlite_master
WHERE type='table' AND sql LIKE '%virtual%table%using%rtree%'
} {
set nCol [expr [llength [db eval "pragma table_info($name)"]]/6]
if {$nCol != 5} {
puts stderr "Not viewing $name - is not 2-dimensional"
} else {
lappend rtree_tables [list Table $name]
}
}
if {$rtree_tables eq ""} {
puts stderr "Cannot find an r-tree table in database [lindex $argv 0]"
puts stderr ""
exit
}
eval tk_optionMenu .select option_var $rtree_tables
trace add variable option_var write set_option_var
proc set_option_var {args} {
set ::O(zTab) [lindex $::option_var 1]
set ::O(iNode) 1
view_node
}
set ::O(zTab) [lindex $::rtree_tables 0 1]
bind .l <1> {listbox_click [.l nearest %y]}
bind .l <Motion> {listbox_mouseover [.l nearest %y]}
bind .l <Leave> {listbox_mouseover -1}
proc listbox_click {sel} {
if {$sel ne ""} {
set ::O(iNode) [lindex $::O(listbox_captions) $sel 1]
view_node
}
}
proc listbox_mouseover {i} {
set oldid [lindex $::O(listbox_itemmap) $::O(listbox_highlight)]
.c itemconfigure $oldid -fill ""
.l selection clear 0 end
.status configure -text ""
if {$i>=0} {
set id [lindex $::O(listbox_itemmap) $i]
.c itemconfigure $id -fill grey
.c lower $id
set ::O(listbox_highlight) $i
.l selection set $i
.status configure -text [cell_report db $::O(zTab) $::O(iNode) $i]
}
}
grid configure .select -row 0 -column 0 -columnspan 2 -sticky nsew
grid configure .b -row 1 -column 0 -columnspan 2 -sticky nsew
grid configure .l -row 2 -column 0 -sticky nsew
grid configure .status -row 3 -column 0 -columnspan 3 -sticky nsew
grid configure .title -row 0 -column 2 -sticky nsew
grid configure .c -row 1 -column 2 -rowspan 2 -sticky nsew
grid configure .ls -row 2 -column 1 -sticky nsew
grid columnconfigure . 2 -weight 1
grid rowconfigure . 2 -weight 1
proc node_bbox {data} {
set xmin 0
set xmax 0
set ymin 0
set ymax 0
foreach {rowid xmin xmax ymin ymax} [lindex $data 0] break
foreach cell [lrange $data 1 end] {
foreach {rowid x1 x2 y1 y2} $cell break
if {$x1 < $xmin} {set xmin $x1}
if {$x2 > $xmax} {set xmax $x2}
if {$y1 < $ymin} {set ymin $y1}
if {$y2 > $ymax} {set ymax $y2}
}
list $xmin $xmax $ymin $ymax
}
proc view_node {} {
set iNode $::O(iNode)
set zTab $::O(zTab)
set data [rtree_node db $zTab $iNode 12]
set depth [rtree_nodedepth db $zTab $iNode]
.c delete all
set ::O(listbox_captions) [list]
set ::O(listbox_itemmap) [list]
set $::O(listbox_highlight) -1
.b configure -state normal
if {$iNode == 1} {.b configure -state disabled}
.title configure -text "Node $iNode: [cell_report db $zTab $iNode -1]"
foreach {xmin xmax ymin ymax} [node_bbox $data] break
set total_area 0.0
set xscale [expr {double([winfo width .c]-20)/($xmax-$xmin)}]
set yscale [expr {double([winfo height .c]-20)/($ymax-$ymin)}]
set xoff [expr {10.0 - $xmin*$xscale}]
set yoff [expr {10.0 - $ymin*$yscale}]
foreach cell $data {
foreach {rowid x1 x2 y1 y2} $cell break
set total_area [expr {$total_area + ($x2-$x1)*($y2-$y1)}]
set x1 [expr {$x1*$xscale + $xoff}]
set x2 [expr {$x2*$xscale + $xoff}]
set y1 [expr {$y1*$yscale + $yoff}]
set y2 [expr {$y2*$yscale + $yoff}]
set id [.c create rectangle $x1 $y1 $x2 $y2]
if {$depth>0} {
lappend ::O(listbox_captions) "Node $rowid"
lappend ::O(listbox_itemmap) $id
}
}
}
proc cell_report {db zTab iParent iCell} {
set data [rtree_node db $zTab $iParent 12]
set cell [lindex $data $iCell]
foreach {xmin xmax ymin ymax} [node_bbox $data] break
set total_area [expr ($xmax-$xmin)*($ymax-$ymin)]
if {$cell eq ""} {
set cell_area 0.0
foreach cell $data {
foreach {rowid x1 x2 y1 y2} $cell break
set cell_area [expr $cell_area+($x2-$x1)*($y2-$y1)]
}
set cell_area [expr $cell_area/[llength $data]]
set zReport [format "Size = %.1f x %.1f Average child area = %.1f%%" \
[expr $xmax-$xmin] [expr $ymax-$ymin] [expr 100.0*$cell_area/$total_area]\
]
append zReport " Sub-tree height: [rtree_nodedepth db $zTab $iParent]"
} else {
foreach {rowid x1 x2 y1 y2} $cell break
set cell_area [expr ($x2-$x1)*($y2-$y1)]
set zReport [format "Size = %.1f x %.1f Area = %.1f%%" \
[expr $x2-$x1] [expr $y2-$y1] [expr 100.0*$cell_area/$total_area]
]
}
return $zReport
}
view_node
bind .c <Configure> view_node
|
