Return to viewrtree.tcl CVS log

Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / ext / rtree

sqlite3

    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