#kons_font 13
package re Tk
wm geom . 800x600
## OpenStreetMap viewer - wersja dla ~/tcl/tclkit_2
#
#lappend auto_path ~/tcl; source ~/tcl/img.kit
package re Img
package re map::slippy
package re map::slippy::fetcher
package re canvas::sqmap
map::slippy::fetcher FETCH 19 http://tile.openstreetmap.org/
# sqmap zamiast canvas-a...
destroy .c
canvas::sqmap .c
.c configure -grid-cell-width [FETCH tilewidth]; # blad ???
.c configure -grid-cell-height [FETCH tileheight]
pack .c -side left -fill both -expand 1
# wazne zm. globalne ...
set zoom 10
set listaImg {}
set lgxx 0; set lgyy 0
# guziki zoom i inne ...
destroy .f
frame .f
pack .f -side left
button .f.b1 -text "+" -padx .7c -command {
zmienZoom 1; .f.zoom config -text "$zoom"
}
pack .f.b1
label .f.zoom -text "$zoom"
pack .f.zoom
button .f.b2 -text "-" -padx .7c -command {
zmienZoom -1; .f.zoom config -text "$zoom"
}
pack .f.b2
# obsluga rysowania kafelek...
proc sqmap_handler {met id cb} {
#_puts [info level 0]
FETCH $met "$::zoom $id" "FETCH_handler $cb"
}
proc FETCH_handler {cb met ti {img ""}} {
#_puts [info level 0]
$cb $met [lrange $ti 1 end] $img
lappend ::listaImg $img
}
.c configure -grid-cell-command sqmap_handler
# Button-1 przemieszcza viewport canvasa...
.c configure -yscrollincr 1
.c configure -xscrollincr 1
set bb 0
bind .c <Button-1> {set bb 1; set xx %x; set yy %y}
bind .c <ButtonRelease-1> {set bb 0}
bind .c <Motion> {
if {!$bb} continue
set delxx [expr {$xx-%x}]; incr lgxx $delxx
set delyy [expr {$yy-%y}]; incr lgyy $delyy
.c xview scroll $delxx units
.c yview scroll $delyy units
set xx %x; set yy %y
}
.c xview moveto 0; .c yview moveto 0; # zerowanie
set lgxx [expr 561*256]
set lgyy [expr 336*256]
.c xview scroll $lgxx units
.c yview scroll $lgyy units
#.c flush; # nie jest potrzebne!
# + skok w okolice Wrzesni...
proc zmienZoom {delZoom} {
global listaImg lgyy lgxx zoom
set hh [winfo height .c]; set ww [winfo width .c]
set y0 [expr {$lgyy+$hh/2}]; set x0 [expr {$lgxx+$ww/2}]
set geo0 [lrange [map::slippy point 2geo "$zoom $y0 $x0"] 1 end]
# + wsp geo srodka viewport (przez zmiana zoom)
set zoom2 [expr {$zoom+$delZoom}]
if {$zoom2>=5 && $zoom2<=18} {set zoom $zoom2}
set point1 [lrange [map::slippy geo 2point "$zoom $geo0"] 1 end]
.c xview moveto 0; .c yview moveto 0
set lgyy [expr {int([lindex $point1 0])-$hh/2}]
set lgxx [expr {int([lindex $point1 1])-$ww/2}]
# + trzeba uwzgl., ze lg* to lewy/gorny rog!
.c xview scroll $lgxx units
.c yview scroll $lgyy units
foreach img $listaImg {catch {image delete $img}}; set listaImg {}
.c flush
# + rysujemy wszystko od nowa
}
if 0 {
# + skad brac wsp geo lewego/gornego rogu viewport-u ?
# zm. lgxx, lgyy to jedyna metoda ?!?!?!
# + jak zmieniac zoom/skale ?
# ???
# + jak zwalniac pamiec img ?
# guzik "flush"; usuwa img z listaImg + ".c flush"
#
set _ "$lgyy $lgxx"
#% 86415 143888
set t1 [map::slippy geo 2tile {10 52.3 17.3}]
#% 10 336 561
# zoom row col
map::slippy tile 2point $t1
#% 10 86016 143616
set hh [winfo height .c]; set ww [winfo width .c]
map::slippy point 2geo "10 [expr {$lgyy+$hh/2}] [expr {$lgxx+$ww/2}]"
#% 10 52.3101578794 17.3693847656
# + oblicza wsp. geo punktu na srodku ekranu
zmienZoom 1
join [.c configure] \n
}