Annotation of embedaddon/sqlite3/ext/rtree/viewrtree.tcl, revision 1.1
1.1 ! misho 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to viewrtree.tcl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / ext / rtree