blob: 2b4dd1bd4a991885773e5b3997c7d09b0515fca2 [file] [log] [blame]
danielk1977ebaecc12008-05-26 18:41:54 +00001
2load ./libsqlite3.dylib
3#package require sqlite3
4source [file join [file dirname $argv0] rtree_util.tcl]
5
6wm title . "SQLite r-tree viewer"
7
8if {[llength $argv]!=1} {
9 puts stderr "Usage: $argv0 <database-file>"
10 puts stderr ""
11 exit
12}
13sqlite3 db [lindex $argv 0]
14
15canvas .c -background white -width 400 -height 300 -highlightthickness 0
16
17button .b -text "Parent Node" -command {
18 set sql "SELECT parentnode FROM $::O(zTab)_parent WHERE nodeno = $::O(iNode)"
19 set ::O(iNode) [db one $sql]
20 if {$::O(iNode) eq ""} {set ::O(iNode) 1}
21 view_node
22}
23
24set O(iNode) 1
25set O(zTab) ""
26set O(listbox_captions) [list]
27set O(listbox_itemmap) [list]
28set O(listbox_highlight) -1
29
30listbox .l -listvariable ::O(listbox_captions) -yscrollcommand {.ls set}
31scrollbar .ls -command {.l yview}
32label .status -font courier -anchor w
33label .title -anchor w -text "Node 1:" -background white -borderwidth 0
34
35
36set rtree_tables [list]
37db eval {
38 SELECT name
39 FROM sqlite_master
40 WHERE type='table' AND sql LIKE '%virtual%table%using%rtree%'
41} {
42 set nCol [expr [llength [db eval "pragma table_info($name)"]]/6]
43 if {$nCol != 5} {
44 puts stderr "Not viewing $name - is not 2-dimensional"
45 } else {
46 lappend rtree_tables [list Table $name]
47 }
48}
49if {$rtree_tables eq ""} {
50 puts stderr "Cannot find an r-tree table in database [lindex $argv 0]"
51 puts stderr ""
52 exit
53}
54eval tk_optionMenu .select option_var $rtree_tables
55trace add variable option_var write set_option_var
56proc set_option_var {args} {
57 set ::O(zTab) [lindex $::option_var 1]
58 set ::O(iNode) 1
59 view_node
60}
61set ::O(zTab) [lindex $::rtree_tables 0 1]
62
63bind .l <1> {listbox_click [.l nearest %y]}
64bind .l <Motion> {listbox_mouseover [.l nearest %y]}
65bind .l <Leave> {listbox_mouseover -1}
66
67proc listbox_click {sel} {
68 if {$sel ne ""} {
69 set ::O(iNode) [lindex $::O(listbox_captions) $sel 1]
70 view_node
71 }
72}
73proc listbox_mouseover {i} {
74 set oldid [lindex $::O(listbox_itemmap) $::O(listbox_highlight)]
75 .c itemconfigure $oldid -fill ""
76
77 .l selection clear 0 end
78 .status configure -text ""
79 if {$i>=0} {
80 set id [lindex $::O(listbox_itemmap) $i]
81 .c itemconfigure $id -fill grey
82 .c lower $id
83 set ::O(listbox_highlight) $i
84 .l selection set $i
85 .status configure -text [cell_report db $::O(zTab) $::O(iNode) $i]
86 }
87}
88
89grid configure .select -row 0 -column 0 -columnspan 2 -sticky nsew
90grid configure .b -row 1 -column 0 -columnspan 2 -sticky nsew
91grid configure .l -row 2 -column 0 -sticky nsew
92grid configure .status -row 3 -column 0 -columnspan 3 -sticky nsew
93
94grid configure .title -row 0 -column 2 -sticky nsew
95grid configure .c -row 1 -column 2 -rowspan 2 -sticky nsew
96grid configure .ls -row 2 -column 1 -sticky nsew
97
98grid columnconfigure . 2 -weight 1
99grid rowconfigure . 2 -weight 1
100
101proc node_bbox {data} {
102 set xmin 0
103 set xmax 0
104 set ymin 0
105 set ymax 0
106 foreach {rowid xmin xmax ymin ymax} [lindex $data 0] break
107 foreach cell [lrange $data 1 end] {
108 foreach {rowid x1 x2 y1 y2} $cell break
109 if {$x1 < $xmin} {set xmin $x1}
110 if {$x2 > $xmax} {set xmax $x2}
111 if {$y1 < $ymin} {set ymin $y1}
112 if {$y2 > $ymax} {set ymax $y2}
113 }
114 list $xmin $xmax $ymin $ymax
115}
116
117proc view_node {} {
118 set iNode $::O(iNode)
119 set zTab $::O(zTab)
120
121 set data [rtree_node db $zTab $iNode 12]
122 set depth [rtree_nodedepth db $zTab $iNode]
123
124 .c delete all
125 set ::O(listbox_captions) [list]
126 set ::O(listbox_itemmap) [list]
127 set $::O(listbox_highlight) -1
128
129 .b configure -state normal
130 if {$iNode == 1} {.b configure -state disabled}
131 .title configure -text "Node $iNode: [cell_report db $zTab $iNode -1]"
132
133 foreach {xmin xmax ymin ymax} [node_bbox $data] break
134 set total_area 0.0
135
136 set xscale [expr {double([winfo width .c]-20)/($xmax-$xmin)}]
137 set yscale [expr {double([winfo height .c]-20)/($ymax-$ymin)}]
138
139 set xoff [expr {10.0 - $xmin*$xscale}]
140 set yoff [expr {10.0 - $ymin*$yscale}]
141
142 foreach cell $data {
143 foreach {rowid x1 x2 y1 y2} $cell break
144 set total_area [expr {$total_area + ($x2-$x1)*($y2-$y1)}]
145 set x1 [expr {$x1*$xscale + $xoff}]
146 set x2 [expr {$x2*$xscale + $xoff}]
147 set y1 [expr {$y1*$yscale + $yoff}]
148 set y2 [expr {$y2*$yscale + $yoff}]
149
150 set id [.c create rectangle $x1 $y1 $x2 $y2]
151 if {$depth>0} {
152 lappend ::O(listbox_captions) "Node $rowid"
153 lappend ::O(listbox_itemmap) $id
154 }
155 }
156}
157
158proc cell_report {db zTab iParent iCell} {
159 set data [rtree_node db $zTab $iParent 12]
160 set cell [lindex $data $iCell]
161
162 foreach {xmin xmax ymin ymax} [node_bbox $data] break
163 set total_area [expr ($xmax-$xmin)*($ymax-$ymin)]
164
165 if {$cell eq ""} {
166 set cell_area 0.0
167 foreach cell $data {
168 foreach {rowid x1 x2 y1 y2} $cell break
169 set cell_area [expr $cell_area+($x2-$x1)*($y2-$y1)]
170 }
171 set cell_area [expr $cell_area/[llength $data]]
172 set zReport [format "Size = %.1f x %.1f Average child area = %.1f%%" \
173 [expr $xmax-$xmin] [expr $ymax-$ymin] [expr 100.0*$cell_area/$total_area]\
174 ]
175 append zReport " Sub-tree height: [rtree_nodedepth db $zTab $iParent]"
176 } else {
177 foreach {rowid x1 x2 y1 y2} $cell break
178 set cell_area [expr ($x2-$x1)*($y2-$y1)]
179 set zReport [format "Size = %.1f x %.1f Area = %.1f%%" \
180 [expr $x2-$x1] [expr $y2-$y1] [expr 100.0*$cell_area/$total_area]
181 ]
182 }
183
184 return $zReport
185}
186
187view_node
188bind .c <Configure> view_node
189