third_party/sqlite/src/ext/rtree/viewrtree.tcl

   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