189 lines
5.3 KiB
Tcl
189 lines
5.3 KiB
Tcl
|
|
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
|