OLD | NEW |
| (Empty) |
1 | |
2 load ./libsqlite3.dylib | |
3 #package require sqlite3 | |
4 source [file join [file dirname $argv0] rtree_util.tcl] | |
5 | |
6 wm title . "SQLite r-tree viewer" | |
7 | |
8 if {[llength $argv]!=1} { | |
9 puts stderr "Usage: $argv0 <database-file>" | |
10 puts stderr "" | |
11 exit | |
12 } | |
13 sqlite3 db [lindex $argv 0] | |
14 | |
15 canvas .c -background white -width 400 -height 300 -highlightthickness 0 | |
16 | |
17 button .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 | |
24 set O(iNode) 1 | |
25 set O(zTab) "" | |
26 set O(listbox_captions) [list] | |
27 set O(listbox_itemmap) [list] | |
28 set O(listbox_highlight) -1 | |
29 | |
30 listbox .l -listvariable ::O(listbox_captions) -yscrollcommand {.ls set} | |
31 scrollbar .ls -command {.l yview} | |
32 label .status -font courier -anchor w | |
33 label .title -anchor w -text "Node 1:" -background white -borderwidth 0 | |
34 | |
35 | |
36 set rtree_tables [list] | |
37 db 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 } | |
49 if {$rtree_tables eq ""} { | |
50 puts stderr "Cannot find an r-tree table in database [lindex $argv 0]" | |
51 puts stderr "" | |
52 exit | |
53 } | |
54 eval tk_optionMenu .select option_var $rtree_tables | |
55 trace add variable option_var write set_option_var | |
56 proc set_option_var {args} { | |
57 set ::O(zTab) [lindex $::option_var 1] | |
58 set ::O(iNode) 1 | |
59 view_node | |
60 } | |
61 set ::O(zTab) [lindex $::rtree_tables 0 1] | |
62 | |
63 bind .l <1> {listbox_click [.l nearest %y]} | |
64 bind .l <Motion> {listbox_mouseover [.l nearest %y]} | |
65 bind .l <Leave> {listbox_mouseover -1} | |
66 | |
67 proc listbox_click {sel} { | |
68 if {$sel ne ""} { | |
69 set ::O(iNode) [lindex $::O(listbox_captions) $sel 1] | |
70 view_node | |
71 } | |
72 } | |
73 proc 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 | |
89 grid configure .select -row 0 -column 0 -columnspan 2 -sticky nsew | |
90 grid configure .b -row 1 -column 0 -columnspan 2 -sticky nsew | |
91 grid configure .l -row 2 -column 0 -sticky nsew | |
92 grid configure .status -row 3 -column 0 -columnspan 3 -sticky nsew | |
93 | |
94 grid configure .title -row 0 -column 2 -sticky nsew | |
95 grid configure .c -row 1 -column 2 -rowspan 2 -sticky nsew | |
96 grid configure .ls -row 2 -column 1 -sticky nsew | |
97 | |
98 grid columnconfigure . 2 -weight 1 | |
99 grid rowconfigure . 2 -weight 1 | |
100 | |
101 proc 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 | |
117 proc 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 | |
158 proc 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 | |
187 view_node | |
188 bind .c <Configure> view_node | |
OLD | NEW |