Return to viewrtree.tcl CVS log

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

Annotation of embedaddon/sqlite3/ext/rtree/viewrtree.tcl, revision 1.1.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