[GRASSLIST:10285] Re: [GRASS5] New release candidate 3 of GIS Manager 2
Michael Barton
michael.barton at asu.edu
Mon Feb 13 19:09:13 EST 2006
I've fixed the errors reported below and updated them to the cvs. I can't
get at my web site to repost the zip file of these changes.
I include the updated small *.tcl files if anyone wants to update without
going through the cvs.
______________________________
Michael Barton, Professor of Anthropology
School of Human Evolution and Social Change
Arizona State University
Tempe, AZ 85287-2402
USA
voice: 480-965-6262; fax: 480-965-7671
www: http://www.public.asu.edu/~cmbarton
>>>>
>
> - When trying to use the text tool, I get:
>
> can't read "anchor": no such variable
> while executing
> "$can($mon) create text $opt($id,xcoord) $opt($id,ycoord) -anchor
> $anchor -justify $opt($id,justify) -width $opt($id,width) -fill
> $opt($id,fill) -..."
>
> (I assume it is the "Add text layer" button.)
>
>
>
2.
I. Click "Pan" tool.
II. Left-click+hold button on the canvas but _don't_ drag.
III. Release the button.
Error:
can't read "to_x": no such variable
can't read "to_x": no such variable
while executing
"scrx2mape $to_x"
(procedure "MapCanvas::pan" line 11)
invoked from within
"MapCanvas::pan $mon"
(command bound to event)
My destop switcher freezes, using over 90% CPU, have to kill and
restart it to continue Gnome operation (Ubuntu 5.10 Breezy/Gnome).
-------------- next part --------------
###############################################################
# maptext.tcl - TclTk canvas text layer options file for GRASS GIS Manager
# February 2006 Michael Barton, Arizona State University
###############################################################
namespace eval GmCtext {
variable array opt # ctext options
variable count 1
}
proc GmCtext::create { tree parent } {
variable opt
variable count
global gmpath
global frm
set node "ctext:$count"
set frm [ frame .ctexticon$count]
set fon [font create -size 10]
set check [checkbutton $frm.check -font $fon \
-variable GmCtext::opt($count,_check) \
-height 1 -padx 0 -width 0]
image create photo ctico -file "$gmpath/maptext.gif"
set ico [label $frm.ico -image ctico -bd 1 -relief raised]
pack $check $ico -side left
$tree insert end $parent $node \
-text "text layer $count"\
-window $frm \
-drawcross auto
set opt($count,_check) 1
set opt($count,text) ""
set opt($count,xcoord) 100
set opt($count,ycoord) 100
set opt($count,font) "times 12"
set opt($count,fill) \#000000
set opt($count,width) 100
set opt($count,anchor) "center_left"
set opt($count,justify) "left"
set opt($count,coordinates) "pixels"
incr count
return $node
}
proc GmCtext::select_font { id } {
global mon
global frm
variable opt
set fon [SelectFont $frm.font -type dialog -sampletext 1 -title "Select font"]
if { $fon != "" } {set opt($id,font) $fon}
}
proc GmCtext::set_option { node key value } {
variable opt
set id [GmTree::node_id $node]
set opt($id,$key) $value
}
# ctext options
proc GmCtext::options { id frm } {
variable opt
global gmpath
global bgcolor
# Panel heading
set row [ frame $frm.heading ]
Label $row.a -text "Display text" \
-fg MediumBlue
pack $row.a -side left
pack $row -side top -fill both -expand yes
# text
set row [ frame $frm.text ]
Label $row.a -text "Text to display:"
LabelEntry $row.b -textvariable GmCtext::opt($id,text) -width 50 \
-entrybg white
pack $row.a $row.b -side left
pack $row -side top -fill both -expand yes
# coordinates1
set row [ frame $frm.east_north ]
Label $row.a -text "Text placement: x & y coordinates (from upper left) "
LabelEntry $row.b -textvariable GmCtext::opt($id,xcoord) -width 8 \
-entrybg white
LabelEntry $row.c -textvariable GmCtext::opt($id,ycoord) -width 8 \
-entrybg white
pack $row.a $row.b $row.c -side left
pack $row -side top -fill both -expand yes
# coordinates2
set row [ frame $frm.textcoord2 ]
Label $row.a -text [G_msg " coordinate type for text placement"]
ComboBox $row.b -padx 2 -width 10 -textvariable GmCtext::opt($id,coordinates) \
-values {"pixels" "percent" "geographic" } -entrybg white
pack $row.a $row.b -side left
pack $row -side top -fill both -expand yes
# text options1
set row [ frame $frm.textopt1 ]
Label $row.a -text [G_msg " align text with coordinate point "]
ComboBox $row.b -padx 2 -width 12 -textvariable GmCtext::opt($id,anchor) \
-values {"lower_left" "bottom_center" "lower_right" "center_left" "center"
"center_right" "upper_left" "top_center" "upper_right" } \
-entrybg white
pack $row.a $row.b -side left
pack $row -side top -fill both -expand yes
# text options2
set row [ frame $frm.textopt2 ]
Label $row.a -text [G_msg " justification"]
ComboBox $row.b -padx 2 -width 7 -textvariable GmCtext::opt($id,justify) \
-values {"left" "center" "right"} -entrybg white
Label $row.c -text " line width"
LabelEntry $row.d -textvariable GmCtext::opt($id,width) -width 5 \
-entrybg white
pack $row.a $row.b $row.c $row.d -side left
pack $row -side top -fill both -expand yes
# select font
set row [ frame $frm.font ]
Label $row.a -text [G_msg "Font:"]
Button $row.b -image [image create photo -file "$gmpath/font.gif"] \
-highlightthickness 0 -takefocus 0 -relief raised -borderwidth 1 \
-helptext [G_msg "select font for text"] \
-command "GmCtext::select_font $id"
Entry $row.c -width 15 -text "$opt($id,font)" \
-textvariable GmCtext::opt($id,font) \
-background white
Label $row.d -text [G_msg " color"]
SelectColor $row.e -type menubutton -variable GmCtext::opt($id,fill)
pack $row.a $row.b $row.c $row.d $row.e -side left
pack $row -side top -fill both -expand yes
}
proc GmCtext::save { tree depth node } {
variable opt
set id [GmTree::node_id $node]
foreach key { _check text east_north font path charset color \
size align rotation linespacing bold textcoord radians htpixel } {
GmTree::rc_write $depth "$key $opt($id,$key)"
}
}
proc GmCtext::display { node } {
variable opt
variable tree
variable can
global mon
global gmpath
global canvas_w
global canvas_h
set line ""
set input ""
set cmd ""
set tree($mon) $GmTree::tree($mon)
set id [GmTree::node_id $node]
set can($mon) $MapCanvas::can($mon)
if { ! ( $opt($id,_check) ) } { return }
if { $opt($id,text) == "" } { return }
switch $opt($id,anchor) {
"lower_left" { set anchor "sw"}
"bottom_center" { set anchor "s" }
"lower_right" { set anchor "se"}
"center_left" { set anchor "w" }
"center" { set anchor "center" }
"center_right" { set anchor "e" }
"upper_left" { set anchor "nw"}
"top_center" { set anchor "n" }
"upper_right" { set anchor "ne"}
}
if {$opt($id,coordinates) == "geographic"} {
set xcoord [MapCanvas::mape2scrx $opt($id,xcoord)]
set ycoord [MapCanvas::mapn2scry $opt($id,ycoord)]
$can($mon) create text $xcoord $ycoord \
-anchor $anchor \
-justify $opt($id,justify) \
-width $opt($id,width) \
-fill $opt($id,fill) \
-font $opt($id,font) \
-text $opt($id,text)
} elseif {$opt($id,coordinates) == "percent"} {
set xpct [expr ($opt($id,xcoord) / 100.0) * $canvas_w($mon)]
set ypct [expr ($opt($id,ycoord) / 100.0) * $canvas_h($mon)]
$can($mon) create text $xpct $ypct \
-anchor $anchor \
-justify $opt($id,justify) \
-width $opt($id,width) \
-fill $opt($id,fill) \
-font $opt($id,font) \
-text $opt($id,text)
} else {
$can($mon) create text $opt($id,xcoord) $opt($id,ycoord) \
-anchor $anchor \
-justify $opt($id,justify) \
-width $opt($id,width) \
-fill $opt($id,fill) \
-font $opt($id,font) \
-text $opt($id,text)
}
}
proc GmCtext::duplicate { tree parent node id } {
variable opt
variable count
global gmpath
set node "ctext:$count"
set frm [ frame .ctexticon$count]
set fon [font create -size 10]
set check [checkbutton $frm.check -font $fon \
-variable GmCtext::opt($count,_check) \
-height 1 -padx 0 -width 0]
image create photo ctico -file "$gmpath/maptext.gif"
set ico [label $frm.ico -image ctico -bd 1 -relief raised]
pack $check $ico -side left
if { $opt($id,text) == ""} {
$tree insert end $parent $node \
-text "text layer $count" \
-window $frm \
-drawcross auto
}
set opt($count,_check) $opt($id,_check)
set opt($count,text) $opt($id,text)
set opt($count,xcoord) $opt($id,xcoord)
set opt($count,ycoord) $opt($id,ycoord)
set opt($count,font) $opt($id,font)
set opt($count,fill) $opt($id,fill)
set opt($count,width) $opt($id,width)
set opt($count,anchor) $opt($id,anchor)
set opt($count,justify) $opt($id,justify)
set opt($count,coordinates) $opt($id,coordinates)
incr count
return $node
}
-------------- next part --------------
##########################################################################
#
# MapCanvas.tcl -TclTk canvas display monitors and display controls
# for GIS Manager: GUI for GRASS 6
#
# Author: Michael Barton (Arizona State University)
#
# January 2006
#
# COPYRIGHT: (C) 1999 - 2006 by the GRASS Development Team
#
# This program is free software under the GNU General Public
# License (>=v2). Read the file COPYING that comes with GRASS
# for details.
#
##########################################################################
source $gmpath/maptool.tcl
source $gmpath/gmtree.tcl
source $env(GISBASE)/etc/gtcltk/gmsg.tcl
source $env(GISBASE)/etc/gtcltk/select.tcl
source $env(GISBASE)/etc/gui.tcl
set bgcolor HoneyDew2
namespace eval MapCanvas {
variable array can # mon
variable array mapcan # mon
variable array mapframe # mon
variable array canvas_w # mon
variable array canvas_h # mon
variable array map_ind # mon
variable array coords # mon
global array canvas_w # mon
global array canvas_h # mon
variable array tree # mon
variable cmstatus
variable mapmon
}
set initwd 640
set initht 480
set east 0
set north 0
#image create photo mapimg.$mon
###############################################################################
# Create window and canvas for display
proc MapCanvas::create { } {
global gmpath
global bgcolor
global outtext
global env
global initwd
global initht
global east
global north
global b1east b1north
global tree_pane
global mon
global win
global currmon
global canvas_w
global canvas_h
global drawprog
global array MapCanvas::msg # mon
variable mapmon
variable mapframe
variable mapcan
variable can
variable coords
variable map_ind
# Initialize window and map geometry
set canvas_w($mon) $initwd
set canvas_h($mon) $initht
set env(GRASS_WIDTH) $initwd
set env(GRASS_HEIGHT) $initht
set drawprog 0
set win ""
# Create canvas monitor as top level mainframe
toplevel .mapcan($mon)
set mapframe($mon) [MainFrame .mapcan($mon).mf \
-background $bgcolor -textvariable MapCanvas::msg($mon) \
-progressvar drawprog -progressmax 100 -progresstype incremental]
# toolbar creation
set map_tb [$mapframe($mon) addtoolbar]
MapToolBar::create $map_tb
# canvas creation
set can($mon) [canvas $mapframe($mon).can \
-background #ffffff -borderwidth 0 -closeenough 10.0 \
-insertbackground black -relief groove -selectbackground #c4c4c4 \
-selectforeground black -width $canvas_w($mon) -height $canvas_h($mon) ]
# setting geometry
place $can($mon) -in $mapframe($mon) -x 0 -y 0 -anchor nw
pack $can($mon) -fill both -expand yes
# indicator creation
set map_ind($mon) [$mapframe($mon) addindicator -textvariable coords($mon) \
-width 33 -justify left -padx 5]
set fon [font create -family Verdana -size 12 ]
DynamicHelp::configure -font $fon -background yellow
pack $mapframe($mon) -fill both -expand yes
MapCanvas::coordconv $mon
# bindings for display canvas
set currmon $mon
# mouse handlers
bind $can($mon) <ButtonPress-1> {
global mon b1east b1north win
global currmon
variable tree
set winx [winfo pointerx .]
set winy [winfo pointery .]
set win [winfo containing $winx $winy]
regexp -nocase {.*\((\d*)(\).*)} $win win1 currmon win2
set b1east [MapCanvas::scrx2mape %x]
set b1north [MapCanvas::scry2mapn %y]
if { $mon != $currmon } {
set mon $currmon
GmTree::switchpage $mon
}
}
bind $mapframe($mon) <ButtonPress-1> {
global mon b1east b1north win
global currmon
variable tree
set winx [winfo pointerx .]
set winy [winfo pointery .]
set win [winfo containing $winx $winy]
regexp -nocase {.*\((\d*)(\).*)} $win win1 currmon win2
if { $mon != $currmon } {
set mon $currmon
GmTree::switchpage $mon
}
}
bind .mapcan($mon) <ButtonPress-1> {
global mon b1east b1north win
global currmon
variable tree
set winx [winfo pointerx .]
set winy [winfo pointery .]
set win [winfo containing $winx $winy]
regexp -nocase {.*\((\d*)(\).*)} $win win1 currmon win2
if { $mon != $currmon } {
set mon $currmon
GmTree::switchpage $mon
}
}
bind $can($mon) <Motion> {
set scrxmov %x
set scrymov %y
set eastcoord [eval MapCanvas::scrx2mape %x]
set northcoord [eval MapCanvas::scry2mapn %y]
set coords($mon) "$eastcoord $northcoord"
}
# window configuration change handler for resizing
bind $can($mon) <Configure> {
global canvas_w
global canvas_h
set rwinx [winfo pointerx .]
set rwiny [winfo pointery .]
set rwin [winfo containing $rwinx $rwiny]
regexp -nocase {.*\((\d*)(\).*)} $rwin rwin1 currmon rwin2
set mon $currmon
if { $canvas_w($mon) != %w || $canvas_h($mon) != %h } {
set canvas_w($mon) %w
set canvas_h($mon) %h
update idletasks
after cancel MapCanvas::do_resize $mon
after idle MapCanvas::do_resize $mon
}
}
# bindings for closing map display window
bind .mapcan($mon) <Destroy> {
set destroywin %W
MapCanvas::cleanup $mon $destroywin
}
}
###############################################################################
# map display procedures
# set up map geometry
proc MapCanvas::mapsettings { mon } {
global outtext
global env
global gmpath
global mapimg.$mon
global gisdbase
global location_name
global mapset
variable mapcan
variable can
global canvas_h
global canvas_w
set monregion "$gisdbase/$location_name/$mapset/windows/mon_$mon"
if {[file exists $monregion] } {
set cmd "g.region region=mon_$mon"
runcmd $cmd
} else {
set cmd "g.region save=mon_$mon --o"
runcmd $cmd
}
if ![catch {open "|g.region -g" r} input] {
while {[gets $input line] >= 0} {
regexp -nocase {n=(.*)} $line n1 map_n
regexp -nocase {^s=(.*)} $line s1 map_s
regexp -nocase {e=(.*)} $line e1 map_e
regexp -nocase {w=(.*)} $line w1 map_w
}
}
set mapwd [expr abs(1.0 * ($map_e - $map_w))]
set mapht [expr abs(1.0 * ($map_n - $map_s))]
if { [expr $canvas_h($mon) / $canvas_w($mon)] > [expr $mapht / $mapwd] } {
set mapdispht [expr 1.0 * $canvas_w($mon) * $mapht / $mapwd]
set mapdispwd $canvas_w($mon)
} else {
set mapdispht $canvas_h($mon)
set mapdispwd [expr 1.0 * $canvas_h($mon) * $mapwd / $mapht]
}
set env(GRASS_WIDTH) $mapdispwd
set env(GRASS_HEIGHT) $mapdispht
set env(GRASS_PNGFILE) "dispmon_$mon.ppm"
set env(GRASS_TRANSPARENT) "FALSE"
set env(GRASS_PNG_AUTO_WRITE) "TRUE"
set env(GRASS_TRUECOLOR) "TRUE"
}
# draw map using png driver and open in canvas
proc MapCanvas::drawmap { mon } {
global outtext
global env
global gmpath
global mapset
global canvas_w
global canvas_h
global mapimg.mon
global mapfile
global drawprog
global MapCanvas::msg
variable mapframe
variable mapcan
variable can
set drawprog 0
set MapCanvas::msg($mon) "please wait..."
$mapframe($mon) showstatusbar progression
# start draw map routine only if gism PNG driver is not running
if ![catch {open "|d.mon -L" r} input] {
while {[gets $input line] >= 0} {
if {[regexp "^gism.*not running" $line]} {
runcmd "d.mon start=gism -s"
incr drawprog
set env(MONITOR_OVERRIDE) "gism"
incr drawprog
runcmd "d.frame -e"
incr drawprog
GmGroup::display "root"
incr drawprog
runcmd "d.mon stop=gism"
incr drawprog
image create photo mapimg.$mon -file "dispmon_$mon.ppm"
set drawprog 100
$can($mon) create image 0 0 -anchor nw \
-image "mapimg.$mon" \
-tag map$mon
GmTree::cvdisplay "root"
incr drawprog
}
}
}
close $input
MapCanvas::coordconv $mon
set drawprog 0
set MapCanvas::msg($mon) "east & north coordinates under cursor"
$mapframe($mon) showstatusbar status
return
}
###############################################################################
proc MapCanvas::do_resize {mon} {
global canvas_w
global canvas_h
global mapimg.$mon
global draw
global drawprog
variable can
MapCanvas::coordconv $mon
$can($mon) delete map$mon
MapCanvas::mapsettings $mon
MapCanvas::drawmap $mon
}
###############################################################################
# erase to white
proc MapCanvas::erase { mon } {
variable mapcan
variable can
$can($mon) delete map$mon
$can($mon) delete all
}
###############################################################################
# zoom to current region
proc MapCanvas::zoom_current { mon } {
variable can
global canvas_h
global canvas_w
run "g.region save=previous_zoom --o"
set cmd "g.region save=mon_$mon --o"
run_panel $cmd
$can($mon) delete map$mon
MapCanvas::mapsettings $mon
MapCanvas::drawmap $mon
}
###############################################################################
# zoom to default region
proc MapCanvas::zoom_default { mon } {
variable can
global canvas_h
global canvas_w
run "g.region save=previous_zoom --o"
set cmd "g.region -d save=mon_$mon --o"
run_panel $cmd
$can($mon) delete map$mon
MapCanvas::mapsettings $mon
MapCanvas::drawmap $mon
}
###############################################################################
# zoom to saved region
proc MapCanvas::zoom_region { mon } {
variable can
global canvas_h
global canvas_w
set reg [GSelect windows]
if { $reg != "" } {
run "g.region save=previous_zoom --o"
set cmd "g.region region=$reg save=mon_$mon --o"
run_panel $cmd
}
$can($mon) delete map$mon
MapCanvas::mapsettings $mon
MapCanvas::drawmap $mon
}
###############################################################################
# procedures for interactive zooming in and zooming out
# zoom bindings
proc MapCanvas::zoombind { mon zoom } {
variable can
global mapcursor
global MapCanvas::msg
set mapcursor [$can($mon) cget -cursor]
set MapCanvas::msg($mon) "L mouse button draws zoom rectangle, R button zooms"
bind $can($mon) <2> ""
bind $can($mon) <3> ""
bind $can($mon) <1> {
MapCanvas::markzoom $mon %x %y
MapCanvas::setcursor $mon "plus"
}
bind $can($mon) <B1-Motion> "MapCanvas::drawzoom $mon %x %y"
# bind $can($mon) <ButtonRelease-1> "MapCanvas::zoomregion $mon $zoom"
bind $can($mon) <3> "MapCanvas::zoomregion $mon $zoom"
}
# start zoom rectangle
proc MapCanvas::markzoom {mon x y} {
global areaX1 areaY1
variable can
set areaX1 [$can($mon) canvasx $x]
set areaY1 [$can($mon) canvasy $y]
$can($mon) delete area
}
# draw zoom rectangle
proc MapCanvas::drawzoom { mon x y } {
variable can
global areaX1 areaY1 areaX2 areaY2
set xc [$can($mon) canvasx $x]
set yc [$can($mon) canvasy $y]
if {($areaX1 != $xc) && ($areaY1 != $yc)} {
$can($mon) delete area
$can($mon) addtag area withtag \
[$can($mon) create rect $areaX1 $areaY1 $xc $yc \
-outline yellow -width 2]
set areaX2 $xc
set areaY2 $yc
}
}
# zoom region
proc MapCanvas::zoomregion { mon zoom } {
variable can
global canvas_h
global canvas_w
global areaX1 areaY1 areaX2 areaY2
# get region extents
if ![catch {open "|g.region -g" r} input] {
while {[gets $input line] >= 0} {
regexp -nocase {n=(.*)} $line n1 map_n
regexp -nocase {^s=(.*)} $line s1 map_s
regexp -nocase {e=(.*)} $line e1 map_e
regexp -nocase {w=(.*)} $line w1 map_w
}
}
# get zoom rectangle extents in canvas coordinates
if { $areaX2 > $areaX1 } {
set cleft $areaX1
set cright $areaX2
} else {
set cright $areaX1
set cleft $areaX2
}
if { $areaY2 > $areaY1 } {
set ctop $areaY1
set cbottom $areaY2
} else {
set cbottom $areaY1
set ctop $areaY2
}
# get zoom rectangle extents in map coordinates
set north [scry2mapn $ctop]
set south [scry2mapn $cbottom]
set east [scrx2mape $cright]
set west [scrx2mape $cleft]
# zoom in
if { $zoom == 1 } {
run "g.region save=previous_zoom --o"
set cmd "g.region n=$north s=$south \
e=$east w=$west save=mon_$mon --o"
run $cmd
}
#zoom out
if { $zoom == -1 } {
set upnorth [expr $map_n + abs($map_n - $north)]
set downsouth [expr $map_s - abs($south - $map_s)]
set backeast [expr $map_e + abs($map_e - $east)]
set outwest [expr $map_w - abs($west - $map_w)]
run "g.region save=previous_zoom --o"
set cmd "g.region n=$upnorth s=$downsouth \
e=$backeast w=$outwest save=mon_$mon --o"
run $cmd
}
# redraw map
$can($mon) delete map$mon
$can($mon) delete area
MapCanvas::mapsettings $mon
MapCanvas::drawmap $mon
# release bindings
bind $can($mon) <1> ""
bind $can($mon) <B1-Motion> ""
bind $can($mon) <ButtonRelease-1> ""
# reset status display to normal
set MapCanvas::msg($mon) "east & north coordinates under cursor"
MapCanvas::restorecursor $mon
return
}
# reinitialize zoom rectangle corners
set areaX1 0
set areaY1 0
set areaX2 0
set areaY2 0
###############################################################################
# zoom back
proc MapCanvas::zoom_back { mon } {
variable can
global canvas_h
global canvas_w
set cmd "g.region region=previous_zoom save=mon_$mon --o"
runcmd $cmd
$can($mon) delete map$mon
MapCanvas::mapsettings $mon
MapCanvas::drawmap $mon
}
###############################################################################
#procedures for panning
# pan bindings
proc MapCanvas::panbind { mon } {
variable can
global mapcursor dtxt
global bgcolor
global MapCanvas::msg
set MapCanvas::msg($mon) "L mouse button to drag & pan, R button stops panning"
set mapcursor [$can($mon) cget -cursor]
bind $can($mon) <2> ""
MapCanvas::setcursor $mon "hand2"
bind $can($mon) <1> {MapCanvas::startpan $mon %x %y}
bind $can($mon) <B1-Motion> {MapCanvas::dragpan $mon %x %y}
bind $can($mon) <ButtonRelease-1> {
MapCanvas::pan $mon
}
bind $can($mon) <3> {MapCanvas::stoppan $mon}
}
proc MapCanvas::startpan {mon x y} {
global start_x start_y
global from_x from_y
global to_x to_y
variable can
set start_x [$can($mon) canvasx $x]
set start_y [$can($mon) canvasy $y]
set from_x $start_x
set from_y $start_y
set to_x $start_x
set to_y $start_y
}
proc MapCanvas::dragpan {mon x y} {
global start_x start_y
global to_x to_y
variable can
set to_x [$can($mon) canvasx $x]
set to_y [$can($mon) canvasy $y]
$can($mon) move current [expr {$to_x-$start_x}] [expr {$to_y-$start_y}]
set start_y $to_y
set start_x $to_x
}
proc MapCanvas::pan { mon } {
global from_x from_y
global to_x to_y
variable can
global canvas_h
global canvas_w
# get map coordinate shift
set from_e [scrx2mape $from_x]
set from_n [scry2mapn $from_y]
set to_e [scrx2mape $to_x]
set to_n [scry2mapn $to_y]
# get region extents
if ![catch {open "|g.region -g" r} input] {
while {[gets $input line] >= 0} {
regexp -nocase {n=(.*)} $line n1 map_n
regexp -nocase {^s=(.*)} $line s1 map_s
regexp -nocase {e=(.*)} $line e1 map_e
regexp -nocase {w=(.*)} $line w1 map_w
}
}
# set new region extents
set north [expr $map_n - ($to_n - $from_n)]
set south [expr $map_s - ($to_n - $from_n)]
set east [expr $map_e - ($to_e - $from_e)]
set west [expr $map_w - ($to_e - $from_e)]
# reset region and redraw map
run "g.region save=previous_zoom --o"
set cmd "g.region n=$north s=$south \
e=$east w=$west save=mon_$mon --o"
run $cmd
$can($mon) delete map$mon
MapCanvas::mapsettings $mon
MapCanvas::drawmap $mon
}
#stop panning
proc MapCanvas::stoppan { mon } {
global MapCanvas::msg
global mapcursor
variable can
# reset cursor to normal
MapCanvas::restorecursor $mon
# reset status display to normal
set MapCanvas::msg($mon) "east & north coordinates under cursor"
# unbind events
bind $can($mon) <1> ""
bind $can($mon) <B1-Motion> ""
bind $can($mon) <ButtonRelease-1> ""
return
}
###############################################################################
proc MapCanvas::setcursor { mon ctype } {
global mapcursor
variable can
$can($mon) configure -cursor $ctype
return
}
proc MapCanvas::restorecursor {mon} {
global mapcursor
variable can
$can($mon) configure -cursor $mapcursor
return
}
###############################################################################
# procedures for measuring
# measurement bindings
proc MapCanvas::measurebind { mon } {
variable can
global mlength totmlength dtxt
global mapcursor
global linex1 liney1 linex2 liney2
global MapCanvas::msg
set mapcursor [$can($mon) cget -cursor]
bind $can($mon) <2> ""
bind $can($mon) <1> "MapCanvas::markmline $mon %x %y"
bind $can($mon) <B1-Motion> "MapCanvas::drawmline $mon %x %y"
bind $can($mon) <ButtonRelease-1> "MapCanvas::measure $mon"
bind $can($mon) <3> "MapCanvas::stopmeasure $mon"
if { ![winfo exists .dispout]} {Gm::create_disptxt $mon}
set MapCanvas::msg($mon) "L mouse button, draw line to measure, R button to stop"
MapCanvas::setcursor $mon "plus"
set mlength 0
set totmlength 0
}
# start measurement line
proc MapCanvas::markmline {mon x y} {
global linex1 liney1 linex2 liney2
variable can
#start line
if { ![info exists linex1] } {
set linex1 [$can($mon) canvasx $x]
set liney1 [$can($mon) canvasy $y]
}
#check for click with no drag
if { ![info exists linex2] } {
set linex2 $linex1
}
if { ![info exists liney2] } {
set liney2 $liney1
}
$can($mon) delete mline
}
# draw measurement line
proc MapCanvas::drawmline { mon x y } {
variable can
global linex1 liney1 linex2 liney2
set xc [$can($mon) canvasx $x]
set yc [$can($mon) canvasy $y]
# draw line segment
if {($linex1 != $xc) && ($liney1 != $yc)} {
$can($mon) delete mline
$can($mon) addtag mline withtag \
[$can($mon) create line $linex1 $liney1 $xc $yc \
-fill red -arrow both -width 2]
set linex2 $xc
set liney2 $yc
}
}
# measure line length
proc MapCanvas::measure { mon } {
variable can
global linex1 liney1 linex2 liney2
global mlength totmlength
global dtxt
# draw cumulative line
$can($mon) addtag totmline withtag \
[$can($mon) create line $linex1 $liney1 $linex2 $liney2 \
-fill green -arrow both -width 2]
# get line endpoints in map coordinates
set east1 [scrx2mape $linex1]
set north1 [scry2mapn $liney1]
set east2 [scrx2mape $linex2]
set north2 [scry2mapn $liney2]
# calculate line segment length and total length
set mlength [expr sqrt(pow(($east1 - $east2), 2) + pow(($north1 - $north2), 2))]
set totmlength [expr $totmlength + $mlength]
$dtxt insert end " --segment length\t= $mlength\n"
$dtxt insert end "cumulative length\t= $totmlength\n"
$dtxt yview end
catch {cmd_output $fh}
set linex1 $linex2
set liney1 $liney2
}
# end measurement
proc MapCanvas::stopmeasure { mon } {
global MapCanvas::msg
variable can
global linex1 liney1 linex2 liney2
global mlength totmlength
# delete measurement line
$can($mon) delete mline
$can($mon) delete totmline
unset linex1
unset liney1
unset linex2
unset liney2
# release bindings
bind $can($mon) <1> ""
bind $can($mon) <2> ""
bind $can($mon) <B1-Motion> ""
bind $can($mon) <ButtonRelease-1> ""
bind $can($mon) <3> ""
# reset status display to normal
set MapCanvas::msg($mon) "east & north coordinates under cursor"
MapCanvas::restorecursor $mon
return
}
###############################################################################
# procedures for querying
# query bindings
proc MapCanvas::querybind { mon } {
global dtxt
global stop
global map_ew
global map_ns
global scr_ew
global scr_ns
global vdist
global type
global options
global mapname
global selected
global mapcursor
variable tree
variable can
# set query 'snapping' distance to 10 screen pixels
set vdist [expr 10* ($map_ew / $scr_ew) ]
if { ![winfo exists .dispout]} {Gm::create_disptxt $mon}
set mapcursor [$can($mon) cget -cursor]
set MapCanvas::msg($mon) "L mouse button to query features, R button to stop query"
bind $can($mon) <1> {
MapCanvas::startquery $mon %x %y
MapCanvas::setcursor $mon "plus"
}
bind $can($mon) <3> {MapCanvas::stopquery $mon}
}
# query
proc MapCanvas::startquery { mon x y } {
global stop
global vdist
variable tree
variable can
set east [scrx2mape $x]
set north [scry2mapn $y]
# get currently selected map for querying
set tree($mon) $GmTree::tree($mon)
set sel [ lindex [$tree($mon) selection get] 0 ]
if { $sel == "" } { return }
set type [GmTree::node_type $sel]
switch $type {
"raster" {
set mapname [GmRaster::mapname $sel]
if { $mapname == "" } {
$dtxt insert end "You must select a map to query\n"
$dtxt yview end
catch {cmd_output $fh}
return
}
set cmd "r.what -f input=$mapname east_north=$east,$north\n\n"
}
"vector" {
set mapname [GmVector::mapname $sel]
if { $mapname == "" } {
$dtxt insert end "You must select a map to query\n"
$dtxt yview end
catch {cmd_output $fh}
return
}
set cmd "v.what -a map=$mapname east_north=$east,$north distance=$vdist\n\n"
}
"rgbhis" {
set mapname [GmRgbhis::mapname $sel]
if { $mapname == "" } {
$dtxt insert end "You must select a map to query\n"
$dtxt yview end
catch {cmd_output $fh}
return
}
set cmd "r.what -f input=$mapname east_north=$east,$north\n\n"
}
dframe {
return
}
chart {
return
}
thematic {
return
}
}
run_panel $cmd
}
# query
proc MapCanvas::stopquery { mon } {
global stop x y east north
variable can
# release bindings
bind $can($mon) <1> ""
bind $can($mon) <3> ""
# reset status display to normal
set MapCanvas::msg($mon) "east & north coordinates under cursor"
MapCanvas::restorecursor $mon
}
###############################################################################
# print to eps file
proc MapCanvas::printcanvas { mon } {
variable mapcan
variable can
global canvas_w
global canvas_h
set cv $can($mon)
# open print window
psprint::init
psprint::window $mon $cv $canvas_w($mon) $canvas_h($mon)
}
###############################################################################
# Set up initial variables for screen to map conversion
proc MapCanvas::coordconv { mon } {
global map_n
global map_s
global map_e
global map_w
global map_ew
global map_ns
global scr_n
global scr_s
global scr_e
global scr_w
global scr_ew
global scr_ns
global map2scrx_conv
global map2scry_conv
global mapframe.can
global mapimg.$mon
variable can
variable mapframe
global canvas_w
global canvas_h
# get current map coordinates from g.region
if ![catch {open "|g.region -g" r} input] {
while {[gets $input line] >= 0} {
regexp -nocase {n=(.*)} $line n1 map_n
regexp -nocase {^s=(.*)} $line s1 map_s
regexp -nocase {e=(.*)} $line e1 map_e
regexp -nocase {w=(.*)} $line w1 map_w
}
}
# calculate dimensions
set map_n [expr 1.0*($map_n)]
set map_s [expr 1.0*($map_s)]
set map_e [expr 1.0*($map_e)]
set map_w [expr 1.0*($map_w)]
set map_ew [expr $map_e - $map_w]
set map_ns [expr $map_n - $map_s]
# get current screen geometry
if { [info exists "mapimg.$mon"] } {
set scr_ew [image width "mapimg.$mon"]
set scr_ns [image height "mapimg.$mon"]
set scr_e [image width "mapimg.$mon"]
set scr_s [image height "mapimg.$mon"]
} else {
set scr_ew $canvas_w($mon)
set scr_ns $canvas_h($mon)
set scr_e $canvas_w($mon)
set scr_s $canvas_h($mon)
}
set scr_n 0.0
set scr_w 0.0
# calculate conversion factors. Note screen is from L->R, T->B but map
# is from L->R, B->T
set map2scrx_conv [expr $scr_ew / $map_ew]
set map2scry_conv [expr $scr_ns / $map_ns]
# calculate screen dimensions and offsets
if { $map2scrx_conv > $map2scry_conv } {
set map2scrx_conv $map2scry_conv
} else {
set map2scry_conv $map2scrx_conv
}
}
###############################################################################
# screen to map and map to screen conversion procedures
# map north to screen y
proc MapCanvas::mapn2scry { north } {
global map_n
global scr_n
global map2scry_conv
return [expr $scr_n + (($map_n - $north) * $map2scry_conv)]
}
# map east to screen x
proc MapCanvas::mape2scrx { east } {
global map_w
global scr_w
global map2scrx_conv
return [expr $scr_w + (($east - $map_w) * $map2scrx_conv)]
}
# screen y to map north
proc MapCanvas::scry2mapn { y } {
global map_n
global scr_n
global map2scry_conv
return [expr $map_n - (($y - $scr_n) / $map2scry_conv)]
}
# screen x to map east
proc MapCanvas::scrx2mape { x } {
global map_w
global scr_w
global map2scrx_conv
return [expr $map_w + (($x - $scr_w) / $map2scrx_conv)]
}
###############################################################################
# transform window x to canvas x
proc winx2canx { x } {
global mon
variable can
return [$can($mon) canvasx x]
}
###############################################################################
# pass mapcan parameter
proc MapCanvas::getmapcan { mon } {
variable mapcan
set mc $mapcan($mon)
return $mc
}
###############################################################################
# cleanup procedure on closing window
proc MapCanvas::cleanup { mon destroywin} {
global pgs
if { $destroywin == ".mapcan($mon)" } {
$pgs delete "page_$mon"
runcmd "g.mremove -f region=mon_$mon "
if { [winfo exists .tlegend($mon)] } { destroy .tlegend($mon) }
}
# stop gism PNG driver if it is still running due to error
if ![catch {open "|d.mon -L" r} input] {
while {[gets $input line] >= 0} {
if {[regexp "^gism Create PNG Map for gism running" $line]} {
runcmd "d.mon stop=gism"
}
}
}
close $input
return
}
###############################################################################
wm geom . [wm geom .]
More information about the grass-user
mailing list