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 189
