1
##########################################################################
3
# georect.tcl -TclTk canvas georectify display and controls
4
# for GIS Manager: GUI for GRASS 6
6
# Author: Michael Barton (Arizona State University).
10
# COPYRIGHT: (C) 1999 - 2006 by the GRASS Development Team
12
# This program is free software under the GNU General Public
13
# License (>=v2). Read the file COPYING that comes with GRASS
16
##########################################################################
19
# All of these must be sourced before using georect.tcl:
20
# source $env(GISBASE)/etc/gtcltk/gmsg.tcl
21
# source $env(GISBASE)/etc/gtcltk/select.tcl
22
# source $env(GISBASE)/etc/gui.tcl
23
# This one is going to be handled by pkgIndex:
26
namespace eval GRMap {
27
variable displayrequest # true if it wants to get displayed.
29
# Something's modified the canvas or view
30
# Degree of modification 0 - none, 1 - zoom, 2 - canvas
31
variable array grcanmodified
32
# The canvas widget of the georectify monitor
36
# Width and height of canvas
39
# Actual width and height used while drawing / compositing
41
# Actual width and height used while drawing / compositing
48
# TMP directory for raster display images used in canvas
53
# variables for coordinate conversions and zooming
70
variable map2scrx_conv
71
variable map2scry_conv
77
#variable grcoords # geographic coordinates from mouse click
78
# geographic coordinates from mouse movement to display in indicator widget
80
# Driver output file (.ppm)
82
#process id to use for temp files
85
# Current region and region historys
86
# Indexed by history (1 (current) - zoomhistories), part (n, s, e, w, nsres, ewres).
87
variable array monitor_zooms
88
# Depth of zoom history to keep
89
variable zoomhistories
92
# Regular order for region values in a list representing a region or zoom
94
set zoom_attrs {n s e w nsres ewres}
96
# string with region information to show in status bar
99
# This variable keeps track of which monitor set the gism driver settings last.
100
# They must always be redone if the monitor was different
101
variable previous_monitor
102
set previous_monitor {none}
104
# Current projection and zone for dynamic region setting for displays
107
variable redrawrequest 0
109
#variables for panning
118
# use GCP in RMS calculations and rectification indexed by gcpnum
119
variable array usegcp
120
# entry widget for GCP xy coordinates indexed by gcpnum
122
# entry widget for GCP forward rms error indexed by gcpnum
124
# entry widget for GCP reverse rms error indexed by gcpnum
126
# gcp form has been created and can be accessed
128
# entry widget for GCP georectified coordinates indexed by gcpnum
130
# checkbutton widget for GCP use indexed by gcpnum
132
# forward projected error value for each GCP indexed by gcpnum
133
variable array fwd_error
134
# backward projected error value for each GCP indexed by gcpnum
135
variable array rev_error
136
# forward and backward projected error
138
# clip or not clip image to target region
142
#forward projected rms error for GCP's, displayed in gcp manager status bar
143
variable fwd_rmserror
144
#backward projected rms error for GCP's, displayed in gcp manager status bar
145
variable rev_rmserror
147
#variables to keep track of location and mapset
154
# gisdbase of xy raster
156
# location of xy raster
158
# mapset of xy raster
160
# raster group to georectify
162
# raster or vector map to display as refernce for setting ground control points
164
# vector map to add or delete from vector group
166
# georectify raster or vector map
168
# is target mapset same as current mapset
170
# vector map for vector group file
172
# rectification method (1,2,3)
175
# initialize variables
178
set currgdb $env(GISDBASE)
179
set currloc $env(LOCATION_NAME)
180
set currmset $env(MAPSET)
183
set fwd_error($gcpnum) ""
194
set rev_error($gcpnum) ""
197
set usegcp($gcpnum) 1
214
###############################################################################
215
# Set location and mapset to selected xy
216
proc GRMap::setxyenv { mset loc } {
220
if { $selftarget == 1 } { return }
222
if { $mset != "" && $loc != "" } {
223
runcmd "g.gisenv set=LOCATION_NAME=$loc"
224
runcmd "g.gisenv set=MAPSET=$mset"
226
set env(LOCATION_NAME) $loc
227
set env(MAPSET) $mset
232
###############################################################################
233
# set location and mapset back to georectified
234
proc GRMap::resetenv { } {
240
if { $selftarget == 1 } { return }
242
runcmd "g.gisenv set=LOCATION_NAME=$currloc"
243
runcmd "g.gisenv set=MAPSET=$currmset"
245
set env(LOCATION_NAME) $currloc
246
set env(MAPSET) $currmset
251
###############################################################################
252
# get xy group to georectify; set target to current location and mapset
253
proc GRMap::getxygroup { vgcreate } {
263
# First, switch to xy mapset
264
GRMap::setxyenv $xymset $xyloc
265
set m [GSelect group]
266
set mname [lindex [split $m "@"] 0]
267
# Return to georectified mapset
270
if { $mname != "" } {
271
set GRMap::xygroup $mname
274
# are we creating a vector group?
275
if { $vgcreate == 1 } {
276
GRMap::read_vgroup $xygroup
280
if { $maptype == "rast" } {
281
# check to see if a raster group exists
282
set groupfile "$xygdb/$xyloc/$xymset/group/$xygroup/REF"
283
if {![file exists $groupfile] } {
284
set GRMap::xygroup ""
285
set msg [G_msg "There is no raster group file (REF). You must select\
286
the 'create/edit group' option to create a group file."]
287
tk_messageBox -message $msg -parent .grstart -type ok
290
# set i.rectify target
291
if { $selftarget == 1 } {
292
set cmd "i.target -c group=$GRMap::xygroup"
294
set cmd "i.target group=$GRMap::xygroup location=$currloc mapset=$currmset"
296
# First, switch to xy mapset
297
GRMap::setxyenv $xymset $xyloc
299
# Return to georectified mapset
301
} elseif { $maptype == "vect" } {
302
# check to see if a vector group exists
303
set groupfile "$xygdb/$xyloc/$xymset/group/$xygroup/VREF"
304
puts "groupfile = $groupfile"
305
if {![file exists $groupfile] } {
306
set GRMap::xygroup ""
307
set msg [G_msg "There is no vector group file (VREF). You must select\
308
the 'create/edit group' option to create a group file."]
309
tk_messageBox -message $msg -parent .grstart -type ok
318
###############################################################################
319
# get raster to display for georectification
320
proc GRMap::getxymap { type } {
325
# First, switch to xy mapset
326
GRMap::setxyenv $xymset $xyloc
328
if { $type == "rast" } {
330
set mname [lindex [split $m "@"] 0]
331
if { $mname != "" } {
332
set GRMap::xymap $mname
334
} elseif {$type == "vect" } {
335
set m [GSelect vector]
336
set mname [lindex [split $m "@"] 0]
337
if { $mname != "" } {
338
set GRMap::xymap $mname
342
# Return to georectified mapset
347
###############################################################################
348
# create or edit raster group to georectify
349
proc GRMap::group { } {
355
if { $maptype == "rast" } {
356
# First, switch to xy mapset
357
GRMap::setxyenv $xymset $xyloc
359
if {[catch {exec -- $cmd --ui } error]} {
363
# Return to georectified mapset
365
} elseif { $maptype == "vect" } {
373
###############################################################################
374
# get mapset of raster to georectify; automatically set location and gisdbase
375
proc GRMap::getmset { } {
387
set path [tk_chooseDirectory -initialdir $currgdb \
388
-title [G_msg "Select mapset of raster to georectify"] \
390
# try to make sure that a valid mapset has been picked
391
if { $path == "" || $path == $currgdb || [file dirname $path] == $currgdb } { return }
393
set xymset [file tail $path]
394
set xylocdir [file dirname $path]
395
set xyloc [file tail $xylocdir]
396
set xygdb [file dirname $xylocdir]
398
# check to see if the target location and mapset is the current one
399
if { $xyloc == $currloc && $xymset == $currmset } {set selftarget 1 }
401
set GRMap::xymset [file tail $path]
403
# create files in tmp diretory for layer output
404
# First, switch to xy mapset
405
GRMap::setxyenv $xymset $xyloc
408
if {[catch {set grfile [exec g.tempfile pid=$mappid]} error]} {
409
GmLib::errmsg $error [G_msg "Error creating tempfile"]
413
set tmpdir [file dirname $grfile]
415
# Return to georectified mapset
420
###############################################################################
421
# dialog to create or edit vector group to georectify
422
proc GRMap::vgroup { } {
433
set vg_mf [MainFrame .vgwin.mf \
434
-textvariable GRMap::vgmsg]
436
set GRMap::vgmsg [G_msg "Create a group REF file and directory for vectors"]
438
set vg_frame [$vg_mf getframe]
441
set vg_tb [$vg_mf addtoolbar]
443
set bbox [ButtonBox $vg_tb.bbox1 -spacing 0 -homogeneous 1 ]
445
# create or replace vector group
446
$bbox add -image [image create photo -file "$iconpath/file-save.gif"] \
447
-command {GRMap::write_vgroup $GRMap::xygroup $GRMap::xyvect} \
448
-highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
449
-helptext [G_msg "Create/replace vector group"]
451
pack $bbox -side left -anchor w -expand no -fill y
454
set vg_sw [ScrolledWindow $vg_frame.sw -relief flat \
456
set vg_sf [ScrollableFrame $vg_sw.sf -height 50 -width 400]
457
$vg_sw setwidget $vg_sf
459
set vgframe [$vg_sf getframe]
461
pack $vg_sw -fill both -expand yes
463
set vg [frame $vgframe.fr]
464
pack $vg -fill both -expand yes
467
pack $vg_mf -side top -expand yes -fill both -anchor n
470
# Scroll the options window with the mouse
473
# Select or set group name
474
set row [ frame $vg.groupname ]
475
Button $row.a -text [G_msg "group name"] \
476
-highlightthickness 0 -takefocus 0 -relief raised -borderwidth 1 \
477
-helptext [G_msg "Select existing vector group or name new group"] \
478
-width 16 -anchor w \
479
-command {GRMap::getxygroup 1}
480
Entry $row.b -width 35 -text "$GRMap::xygroup" \
481
-textvariable GRMap::xygroup
482
pack $row.a $row.b -side left
483
pack $row -side top -fill both -expand yes
485
# select xy vector for group
486
set row [ frame $vg.vect ]
487
Button $row.a -text [G_msg "vector"] \
488
-highlightthickness 0 -takefocus 0 -relief raised -borderwidth 1 \
489
-helptext [G_msg "Select xy vector(s) for group"]\
490
-width 16 -anchor w \
491
-command {GRMap::getxyvect }
492
Entry $row.b -width 35 -text "$GRMap::xyvect" \
493
-textvariable GRMap::xyvect
494
pack $row.a $row.b -side left
495
pack $row -side top -fill both -expand yes
497
GRMap::read_vgroup $GRMap::xygroup
499
wm title .vgwin [G_msg "Vector group"]
503
#cleanup for window closing
504
bind .vgwin <Destroy> {
506
if {$winname == ".vgwin"} {GRMap::cleanup}
511
# get vector for vector group
512
proc GRMap::getxyvect { } {
518
# First, switch to xy mapset
519
GRMap::setxyenv $xymset $xyloc
521
set m [GSelect vector]
522
set mname [lindex [split $m "@"] 0]
523
if { $mname != "" } {
524
if { $GRMap::xyvect == "" } {
525
set GRMap::xyvect $mname
527
append xyvect ",$mname"
531
# Return to georectified mapset
536
proc GRMap::read_vgroup { xygroup } {
541
#get vector list from existing vector group REF file
543
set vgfile "$xygdb/$xyloc/$xymset/group/$xygroup/VREF"
544
if {![file exists $vgfile] } { return }
548
catch {set vlist [open $vgfile]}
549
set vectnames [read $vlist]
550
if {[catch {close $vlist} error]} {
554
set vlines [split $vectnames "\n"]
555
foreach vect $vlines {
556
if { $xyvect == "" } {
557
set GRMap::xyvect $vect
559
append GRMap::xyvect "," $vect
560
set GRMap::xyvect [string trim $GRMap::xyvect ","]
565
proc GRMap::write_vgroup {xygroup xyvect} {
566
#write vector list to vector group REF file
572
set vgfile "$xygdb/$xyloc/$xymset/group/$xygroup/VREF"
574
# if group directory doesn't exist, create it
576
if {![file isdirectory [file dirname $vgfile]] } {
577
file mkdir [file dirname $vgfile]
580
if { $xyvect == "" } { return }
582
# write out vector group file
583
set vlist [split $xyvect ,]
584
catch {set output [open $vgfile w ]}
585
foreach vect $vlist {
588
if {[catch {close $output} error]} {
596
###############################################################################
597
# create dialog to select mapset (and location) and raster map to profile,
598
# and start georectifying canvas
600
proc GRMap::startup { } {
616
set grstarttitle [G_msg "GRASS Georectifier"]
619
wm title .grstart [G_msg $grstarttitle]
622
# create frames for georectify startup
624
set grstart_mf [MainFrame .grstart.mf \
625
-textvariable GRMap::grstartmsg]
627
set GRMap::grstartmsg [G_msg "Set up environment for georectifying rasters or vectors"]
629
set grstartup [$grstart_mf getframe ]
632
set grstart_tb [$grstart_mf addtoolbar]
634
# select raster or vector
635
set selrast [radiobutton $grstart_tb.rast -variable GRMap::maptype -value "rast" \
636
-text [G_msg "Georeference raster"] -highlightthickness 0 \
637
-activebackground $bgcolor -highlightbackground $bgcolor -bg $bgcolor]
639
set selvect [radiobutton $grstart_tb.vect -variable GRMap::maptype -value "vect" \
640
-text [G_msg "Georeference vector"] -highlightthickness 0 \
641
-activebackground $bgcolor -highlightbackground $bgcolor -bg $bgcolor]
642
pack $selrast $selvect -side left
643
pack $grstart_tb -side left -fill both -expand no -padx 5 -pady 3
646
set row [ frame $grstartup.mset -bg $bgcolor]
647
Button $row.a -text [G_msg "1. Select mapset"] \
648
-highlightthickness 0 -takefocus 0 -relief raised -borderwidth 1 \
649
-helptext [G_msg "Mapset of xy raster group"]\
650
-width 16 -anchor w \
651
-command {GRMap::getmset}
652
Entry $row.b -width 35 -text "$GRMap::xymset" \
653
-textvariable GRMap::xymset
654
pack $row.a $row.b -side left
655
pack $row -side top -fill both -expand yes -padx 5 -pady 1
657
# Create raster or vector group
658
set row [ frame $grstartup.group -bg $bgcolor]
659
Button $row.a -text [G_msg "2. Create/edit group"] \
660
-highlightthickness 0 -takefocus 0 -relief raised -borderwidth 1 \
661
-helptext [G_msg "Create/edit group (rasters or vectors to georectify)"] \
662
-width 16 -anchor w \
663
-command {GRMap::group}
664
pack $row.a -side left
665
pack $row -side top -fill both -expand yes -padx 5 -pady 1
668
set row [ frame $grstartup.selgroup -bg $bgcolor]
669
Button $row.a -text [G_msg "3. Select group"] \
670
-highlightthickness 0 -takefocus 0 -relief raised -borderwidth 1 \
671
-helptext [G_msg "Select existing group to georectify"]\
672
-width 16 -anchor w \
673
-command {GRMap::getxygroup 0}
674
Entry $row.b -width 35 -text "$GRMap::xygroup" \
675
-textvariable GRMap::xygroup
676
pack $row.a $row.b -side left
677
pack $row -side top -fill both -expand yes -padx 5 -pady 1
679
# set xy raster or vector
680
set row [ frame $grstartup.map -bg $bgcolor]
681
Button $row.a -text [G_msg "4. Select map"] \
682
-highlightthickness 0 -takefocus 0 -relief raised -borderwidth 1 \
683
-helptext [G_msg "Select non-georectified raster or vector to display for marking ground control points"]\
684
-width 16 -anchor w \
685
-command {GRMap::getxymap $GRMap::maptype}
686
Entry $row.b -width 35 -text "$GRMap::xymap" \
687
-textvariable GRMap::xymap
688
pack $row.a $row.b -side left
689
pack $row -side top -fill both -expand yes -padx 5 -pady 1
691
# Start georectify canvas
692
set row [ frame $grstartup.start -bg $bgcolor]
693
Button $row.a -text [G_msg "5. Start georectifying"] \
694
-highlightthickness 0 -takefocus 0 -relief raised -borderwidth 1 \
695
-helptext [G_msg "Start georectifying"]\
696
-width 16 -anchor w -highlightthickness 0 \
697
-command "GRMap::refmap"
698
pack $row.a -side left
699
pack $row -side top -fill both -expand yes -padx 5 -pady 1
702
set row [ frame $grstartup.quit -bg $bgcolor]
703
Button $row.a -text [G_msg "Cancel"] \
704
-highlightthickness 0 -takefocus 0 -relief raised -borderwidth 1 \
705
-helptext [G_msg "Cancel georectification"]\
706
-width 16 -anchor w -highlightthickness 0 \
707
-command "destroy .grstart"
708
Button $row.b -text [G_msg "Help"] \
709
-image [image create photo -file "$iconpath/gui-help.gif"] \
710
-command "spawn g.manual --q gm_georect" \
711
-background $bgcolor \
712
-helptext [G_msg "Help"]
713
pack $row.a -side left
714
pack $row.b -side right
715
pack $row -side top -fill both -expand yes -padx 5 -pady 1
719
pack $grstartup -side top -fill both -expand yes
721
wm deiconify .grstart
723
focus -force .grstart
725
#cleanup for window closing
726
#bind .grstart <Destroy> "GRMap::cleanup %W"
727
bind .grstart <Destroy> {
728
if { "%W" == ".grstart" } { GRMap::cleanup }
735
###############################################################################
737
# Create window and canvas for displaying xy raster or vector as reference map for
738
# selecting ground control points in the xy system
740
proc GRMap::refmap { } {
759
variable grcoords_mov
764
if { $xymset=="" || $xygroup=="" || $xymap=="" } {
768
# close dialog to select mapset and raster
774
# set environment to xy location
775
GRMap::setxyenv $xymset $xyloc
777
# need to turn off wind_override here
779
# Initialize window and map geometry
780
set grcanvas_w $initwd
781
set grcanvas_h $initht
782
set env(GRASS_WIDTH) $initwd
783
set env(GRASS_HEIGHT) $initht
786
# Make sure that we are using the WIND file for everything except displays
787
if {[info exists env(WIND_OVERRIDE)]} {unset env(WIND_OVERRIDE)}
789
# Set display geometry to the current region settings (from WIND file)
793
# Zoom to map to georectify
794
if { $maptype == "rast" } {
795
GRMap::zoom_gregion [list "rast=$xymap"]
796
} elseif { $maptype == "vect" } {
797
GRMap::zoom_gregion [list "vect=$xymap"]
800
# Create canvas monitor as top level mainframe
802
wm title .mapgrcan [G_msg "Displaying xy map to be georectified"]
804
set grmapframe [MainFrame .mapgrcan.mf \
805
-textvariable GRMap::msg \
806
-progressvar drawprog -progressmax 100 -progresstype incremental]
808
set mf_frame [$grmapframe getframe]
811
set map_tb [$grmapframe addtoolbar]
812
GRToolBar::create $map_tb
815
set grcan [canvas $mf_frame.grcanvas \
816
-borderwidth 0 -closeenough 10.0 -relief groove \
817
-width $grcanvas_w -height $grcanvas_h ]
820
place $grcan -in $mf_frame -x 0 -y 0 -anchor nw
822
pack $grcan -fill both -expand yes
825
set map_ind [$grmapframe addindicator -textvariable grcoords_mov \
826
-width 33 -justify left -padx 5 -bg white]
828
pack $grmapframe -fill both -expand yes
830
set grcursor [$grcan cget -cursor]
834
# bindings for display canvas
837
# The coordinate transforms should be done per monitor.
838
bind $grcan <ButtonPress-1> {
839
set eastcoord [eval GRMap::scrx2mape %x]
840
set northcoord [eval GRMap::scry2mapn %y]
841
set grcoords "$eastcoord $northcoord"
844
# Displays geographic coordinates in indicator window when cursor moved across canvas
845
bind $grcan <Motion> {
848
set eastcoord [eval GRMap::scrx2mape %x]
849
set northcoord [eval GRMap::scry2mapn %y]
850
set grcoords_mov "$eastcoord $northcoord"
854
# TSW - inserting key command ability into gis.m
856
# set some key commands to speed use
858
# Return to previous zoom
859
bind .mapgrcan <KeyPress-r> {
863
# set key strokes to change between tools
864
# I've provided strokes for both right and left handed
870
# zoom ouT - zoom out
874
bind .mapgrcan <KeyPress-x> {
875
GRToolBar::changebutton pointer
878
bind .mapgrcan <KeyPress-z> {
880
GRToolBar::changebutton zoomin
883
bind .mapgrcan <KeyPress-t> {
885
GRToolBar::changebutton zoomout
888
bind .mapgrcan <KeyPress-a> {
890
GRToolBar::changebutton pan
897
# zoom Out - zoom out
901
bind .mapgrcan <KeyPress-n> {
902
GRToolBar::changebutton pointer
905
bind .mapgrcan <KeyPress-i> {
907
GRToolBar::changebutton zoomin
910
bind .mapgrcan <KeyPress-o> {
912
GRToolBar::changebutton zoomout
915
bind .mapgrcan <KeyPress-p> {
917
GRToolBar::changebutton pan
922
# window configuration change handler for resizing
923
bind $grcan <Configure> "GRMap::do_resize"
925
#return to georectified location
928
#default selector tool
931
# bindings for closing windows
932
bind .mapgrcan <Destroy> {
933
if { "%W" == ".mapgrcan" } { GRMap::cleanup }
938
###############################################################################
939
# create form for gcp management
940
proc GRMap::gcpwin {} {
956
variable fwd_rmserror
957
variable rev_rmserror
972
set gcp_mf [MainFrame .gcpwin.mf \
973
-textvariable GRMap::gcpmsg]
975
set gcp_frame [$gcp_mf getframe]
978
set gcp_tb [$gcp_mf addtoolbar]
982
set gcp_sw [ScrolledWindow $gcp_frame.sw -relief flat \
984
set gcp_sf [ScrollableFrame $gcp_sw.sf -height 200 -width 750]
985
$gcp_sw setwidget $gcp_sf
987
set gcpframe [$gcp_sf getframe]
989
pack $gcp_sw -fill both -expand yes
991
set gcp [frame $gcpframe.fr]
992
pack $gcp -fill both -expand yes
995
pack $gcp_mf -side top -expand yes -fill both -anchor n
996
pack $gcp_tb -side left -expand yes -fill x
999
# Scroll the options window with the mouse
1002
if { $maptype == "vect" } {
1003
set rbstate "disabled"
1005
set rbstate "normal"
1008
# setting rectification method
1009
set row [ frame $gcp.method ]
1010
Label $row.a -text [G_msg "Select rectification method for rasters"] \
1012
set first [radiobutton $row.b -variable GRMap::rectorder -value 1 \
1013
-text [G_msg "1st order"] -highlightthickness 0]
1014
DynamicHelp::register $first balloon [G_msg "affine transformation \
1015
(rasters & vectors). Requires 3+ GCPs."]
1018
set second [radiobutton $row.c -variable GRMap::rectorder -value 2 \
1019
-text [G_msg "2nd order"] -highlightthickness 0 -state $rbstate]
1020
DynamicHelp::register $second balloon [G_msg "polynomial transformation \
1021
(rasters only). Requires 6+ GCPs."]
1023
set third [radiobutton $row.d -variable GRMap::rectorder -value 3 \
1024
-text [G_msg "3rd order"] -highlightthickness 0 -state $rbstate]
1025
DynamicHelp::register $third balloon [G_msg "polynomial transformation \
1026
(rasters only). Requires 10+ GCPs."]
1028
Label $row.e -text [G_msg "Clip map/image to target region"] \
1031
set clip [checkbutton $row.f -takefocus 0 -variable GRMap::clipregion]
1033
pack $row.a $row.b $row.c $row.d -side left
1034
pack $row.f $row.e -side right
1035
pack $row -side top -fill both -expand yes
1037
set row [ frame $gcp.header ]
1038
Label $row.a -text [G_msg "Use"] \
1039
-fg MediumBlue -width 3
1040
Label $row.b -text [G_msg "xy coordinates"] \
1041
-fg MediumBlue -width 34
1042
Label $row.c -text [G_msg "geographic coordinates"] \
1043
-fg MediumBlue -width 35
1044
Label $row.d -text [G_msg "forward error"] \
1045
-fg MediumBlue -width 15
1046
Label $row.e -text [G_msg "backward error"] \
1047
-fg MediumBlue -width 15
1048
pack $row.a $row.b $row.c $row.d $row.e -side left
1049
pack $row -side top -fill both -expand yes
1051
for {set gcpnum 1} {$gcpnum < 51 } { incr gcpnum } {
1052
if {$gcpnum == 51} {break}
1053
set GRMap::usegcp($gcpnum) 1
1054
set row [ frame $gcp.row$gcpnum -bd 0]
1055
set chk($gcpnum) [checkbutton $row.a \
1057
-variable GRMap::usegcp($gcpnum)]
1058
set fwd_error($gcpnum) 0.0
1059
set rev_error($gcpnum) 0.0
1061
set xy($gcpnum) [entry $row.b -width 35 -bd 0 ]
1062
bind $xy($gcpnum) <FocusIn> "set xyentry %W"
1064
set geoc($gcpnum) [entry $row.c -width 35 -bd 0]
1065
bind $geoc($gcpnum) <FocusIn> "set geoentry %W"
1067
set fwd($gcpnum) [entry $row.d -width 15 -text GRMap::fwd_error($gcpnum) \
1068
-bd 0 -takefocus 0 -textvariable GRMap::fwd_error($gcpnum)]
1070
set rev($gcpnum) [entry $row.e -width 15 -text GRMap::rev_error($gcpnum) \
1071
-bd 0 -takefocus 0 -textvariable GRMap::rev_error($gcpnum) ]
1073
pack $chk($gcpnum) $xy($gcpnum) $geoc($gcpnum) $fwd($gcpnum) $rev($gcpnum) -side left
1074
pack $row -side top -fill both -expand yes
1082
set GRMap::gcpmsg "Forward RMS error = $fwd_rmserror, backward RMS error = $rev_rmserror"
1084
# set the focus to the first entry
1087
wm title .gcpwin [G_msg "Manage ground control points (GCPs)"]
1089
wm deiconify .gcpwin
1091
# cleanup for window closing
1092
bind .gcpwin <Destroy> {
1093
if { "%W" == ".gcpwin" } { GRMap::cleanup }
1099
# toolbar for gcp manager window
1100
proc GRMap::gcptb { gcptb } {
1104
# gcp management buttons
1105
set bbox [ButtonBox $gcptb.bbox1 -spacing 0 -homogeneous 1 ]
1108
$bbox add -image [image create photo -file "$iconpath/file-save.gif"] \
1109
-command "GRMap::savegcp" \
1110
-highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
1111
-highlightbackground $bgcolor -activebackground $bgcolor\
1112
-helptext [G_msg "Save GCPs to POINTS file"]
1115
$bbox add -image [image create photo -file "$iconpath/gui-gcperase.gif"] \
1116
-command "GRMap::cleargcp" \
1117
-highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
1118
-highlightbackground $bgcolor -activebackground $bgcolor\
1119
-helptext [G_msg "Clear all unchecked GCP entries"]
1122
$bbox add -image [image create photo -file "$iconpath/gui-rms.gif"] \
1123
-command "GRMap::gcp_error" \
1124
-highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
1125
-highlightbackground $bgcolor -activebackground $bgcolor\
1126
-helptext [G_msg "Calculate RMS error"]
1129
$bbox add -image [image create photo -file "$iconpath/gui-georect.gif"] \
1130
-command "GRMap::rectify" \
1131
-highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
1132
-highlightbackground $bgcolor -activebackground $bgcolor\
1133
-helptext [G_msg "Rectify maps in group"]
1136
$bbox add -text [G_msg "Quit"] \
1137
-command {destroy .gcpwin .mapgrcan} \
1138
-highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
1139
-highlightbackground $bgcolor -activebackground $bgcolor\
1140
-helptext [G_msg "Exit georectifier"]
1142
set helpbtn [Button $gcptb.help -text [G_msg "Help"] \
1143
-image [image create photo -file "$iconpath/gui-help.gif"] \
1144
-command "spawn g.manual --q gm_georect" \
1145
-background $bgcolor -borderwidth 1 \
1146
-helptext [G_msg "Help"]]
1148
pack $helpbtn -side right -anchor e
1149
pack $bbox -side left -anchor w -expand no -fill y
1154
proc GRMap::get_gcp { } {
1155
# import any existing points file for raster or gcp file for raster or vector
1170
set gcpfile "$xygdb/$xyloc/$xymset/group/$xygroup/POINTS"
1171
if {[file exists $gcpfile] } {
1174
catch {set pfile [open $gcpfile]}
1175
set points [read $pfile]
1176
if {[catch {close $pfile} error]} {
1177
GmLib::errmsg $error
1179
regsub -all {[ ]+} $points " " points
1180
set plines [split $points "\n"]
1181
foreach gcpline $plines {
1182
if {[string match {\#*} $gcpline]} continue
1183
if {$gcpline == "" } continue
1184
set gcpline [string trim $gcpline " "]
1185
set fields [split $gcpline { }]
1187
$xy($gcpnum) insert 0 "[lindex $fields 0] [lindex $fields 1]"
1188
$geoc($gcpnum) insert 0 "[lindex $fields 2] [lindex $fields 3]"
1189
set usegcp($gcpnum) "[lindex $fields 4]"
1196
# save GCP's to POINTS file in xy location and mapset
1197
proc GRMap::savegcp {} {
1209
variable array gcpline #array to store gcp coordinates as text for output
1211
set gcpfile "$xygdb/$xyloc/$xymset/group/$xygroup/POINTS"
1212
catch {set output [open $gcpfile w ]}
1213
puts $output "# Ground Control Points File"
1215
puts $output "# target location: $currloc"
1216
puts $output "# target mapset: $currmset"
1217
puts $output "#unrectified xy georectified east north 1=use gcp point"
1218
puts $output "#-------------- ----------------------- ---------------"
1221
for {set gcpnum 1} {$gcpnum < 51 } { incr gcpnum } {
1222
if { $maptype == "rast" } {
1223
if { [$xy($gcpnum) get] != "" && [$geoc($gcpnum) get] != ""} {
1224
set gcpline($gcpnum) "[$xy($gcpnum) get]"
1225
append gcpline($gcpnum) " [$geoc($gcpnum) get]"
1226
append gcpline($gcpnum) " $usegcp($gcpnum)"
1227
puts $output $gcpline($gcpnum)
1230
} elseif { $maptype == "vect" } {
1231
if { [$xy($gcpnum) get] != "" && [$geoc($gcpnum) get] != "" && $usegcp($gcpnum) == 1} {
1232
set gcpline($gcpnum) "[$xy($gcpnum) get]"
1233
append gcpline($gcpnum) " [$geoc($gcpnum) get]"
1234
append gcpline($gcpnum) " $usegcp($gcpnum)"
1235
puts $output $gcpline($gcpnum)
1241
if {[catch {close $output} error]} {
1242
GmLib::errmsg $error
1248
proc GRMap::gcp_error { } {
1249
# calculate error for each gcp and total RMS error - projected forward and reverse
1260
variable fwd_rmserror
1261
variable rev_rmserror
1263
set fwd_rmssumsq 0.0
1264
set fwd_rmserror 0.0
1265
set rev_rmssumsq 0.0
1266
set rev_rmserror 0.0
1270
# save current GCP values to POINTS file to use in error calculations
1273
set gcpfile "$xygdb/$xyloc/$xymset/group/$xygroup/POINTS"
1274
if {![file exists $gcpfile] } { return }
1276
# First, switch to xy mapset
1277
GRMap::setxyenv $xymset $xyloc
1278
# calculate diagonal distance error for each GCP
1279
catch {set input [open "|g.transform group=$xygroup order=$rectorder"]}
1280
set errorlist [read $input]
1281
if {[catch {close $input} error]} {
1282
GmLib::errmsg $error
1285
# Return to georectified mapset
1289
foreach {fwd rev} $errorlist {
1290
set GRMap::fwd_error($gcpnum) $fwd
1291
set GRMap::rev_error($gcpnum) $rev
1292
set fwd_rmssumsq [expr $fwd_rmssumsq + pow($fwd,2)]
1293
set rev_rmssumsq [expr $rev_rmssumsq + pow($rev,2)]
1297
# calculate total rms error for all points
1298
set GRMap::fwd_rmserror [expr sqrt($fwd_rmssumsq/$gcpnum)]
1299
set GRMap::rev_rmserror [expr sqrt($rev_rmssumsq/$gcpnum)]
1301
# update value in status bar
1302
set GRMap::gcpmsg "Forward RMS error = $fwd_rmserror, backward RMS error = $rev_rmserror"
1306
# run i.rectify to rectify raster group or v.transform to rectify vector
1307
proc GRMap::rectify { } {
1321
set gcpfile "$xygdb/$xyloc/$xymset/group/$xygroup/POINTS"
1322
if {![file exists $gcpfile] } {
1323
set msg [G_msg "There is no POINTS file of ground control points for group.\
1324
You must create ground control points before georectifying map."]
1325
tk_messageBox -message $msg -parent .gcpwin -type ok
1329
# count useable GCP's in points file
1331
catch {set pfile [open $gcpfile]}
1332
set points [read $pfile]
1333
if {[catch {close $pfile} error]} {
1334
GmLib::errmsg $error
1337
regsub -all {[ ]+} $points " " points
1338
set plines [split $points "\n"]
1339
foreach gcpline $plines {
1340
if {[string match {\#*} $gcpline]} continue
1341
if {$gcpline == "" } continue
1342
set gcpline [string trim $gcpline " "]
1343
set fields [split $gcpline { }]
1345
if {[lindex $fields 0]!="" && [lindex $fields 1]!="" && [lindex $fields 2]!=""
1346
&& [lindex $fields 3]!="" && [lindex $fields 4]==1} {
1351
if { $maptype == "rast" } {
1352
if { $gcpcnt<3 || ($gcpcnt<6 && $rectorder==2) || ($gcpcnt<10 && $rectorder==3) } {
1353
set msg [G_msg "Insufficient ground control points for georectification method.\
1354
You need at least 3 points for 1st order, 6 points for 2nd order and 10 points for 3rd order."]
1355
tk_messageBox -message $msg -parent .gcpwin -type ok
1358
# run i.rectify on raster group
1359
# First, switch to xy mapset
1360
GRMap::setxyenv $xymset $xyloc
1362
# set message_env [exec g.gisenv get=GRASS_MESSAGE_FORMAT]
1363
# set env(GRASS_MESSAGE_FORMAT) gui
1364
# if {![catch {open [concat "|i.rectify" "-ca" "group=$xygroup" "extension=$mappid" "order=$rectorder"] r} fh]} {
1365
# while {[gets $fh line] >= 0} {
1366
# puts "line = $line"
1370
# set env(GRASS_MESSAGE_FORMAT) $message_env
1372
# if {[catch {close $fh} error]} {
1376
set cmd "i.rectify -a group=$xygroup extension=$mappid order=$rectorder"
1377
if { $GRMap::clipregion == 1 } { append cmd " -c"}
1380
# Return to georectified mapset
1382
} elseif { $maptype == "vect" } {
1383
if { $gcpcnt < 1 } {
1384
set msg [G_msg "No valid ground control points in GCP file.\
1385
You must create valid ground control points before georectifying map."]
1386
tk_messageBox -message $msg -parent .gcpwin -type ok
1390
# loop to rectify all vectors in VREF file using v.transform
1391
GRMap::read_vgroup $xygroup
1392
set vlist [split $xyvect ,]
1394
foreach vect $vlist {
1396
append outname "_$mappid"
1397
# First, switch to xy mapset
1398
GRMap::setxyenv $xymset $xyloc
1399
set cmd "v.transform --q input=$vect output=$outname pointsfile=$gcpfile"
1401
# Return to georectified mapset
1403
# copy vector file from source to target location and mapset
1404
if { $selftarget == 0 } {
1405
set xysource "$xygdb/$xyloc/$xymset/vector/$outname"
1406
set xytarget "$xygdb/$currloc/$currmset/vector/$outname"
1407
set xyfile "$xysource"
1408
append xyfile "/coor"
1410
# wait to make sure georectified file is written
1411
while { $counter < 100 } {
1412
if { [file exists $xyfile] } {
1413
catch {file copy -force $xysource $xytarget}
1414
catch {file delete -force $xysource}
1429
# clear all GCP entries
1430
proc GRMap::cleargcp {} {
1439
for {set gcpnum 1} {$gcpnum < 51 } { incr gcpnum } {
1440
if {$usegcp($gcpnum) == 0} {
1441
$xy($gcpnum) delete 0 end
1442
$geoc($gcpnum) delete 0 end
1443
$fwd($gcpnum) delete 0 end
1444
$rev($gcpnum) delete 0 end
1447
$grcan delete gcpvert gcphoriz
1450
###############################################################################
1452
# Calculate boxes with a given aspect ratio.
1454
# Sense - 0 means largest no larger, 1 means smallest no smaller
1455
# We will change box 1
1456
proc GRMap::shrinkwrap {sense nsew1 ar2 } {
1457
foreach {n1 s1 e1 w1} $nsew1 {break}
1459
set ns1 [expr {$n1 - $s1}]
1460
set ew1 [expr {$e1 - $w1}]
1463
# Big aspect ratio is wide, small aspect ratio is tall
1464
set ar1 [expr { 1.0 * $ew1 / $ns1 }]
1466
# If box one is wider than box 2.
1467
# (or box one isn't wider than box 2 and the sense is inverted)
1468
if {($ar1 > $ar2) ^ $sense} {
1469
# n1 and s1 are unchanged
1470
# e1 and w1 must be scaled by ar2
1473
set goal [expr {$ns1 * $ar2}]
1474
set midpoint [expr {$w1 + $ew1 / 2}]
1475
set re1 [expr {$midpoint + $goal / 2}]
1476
set rw1 [expr {$midpoint - $goal / 2}]
1478
# e1 and w1 are unchanged
1479
# n1 and s1 must be scaled by 1/ar2
1482
set goal [expr {$ew1 / $ar2}]
1483
set midpoint [expr {$s1 + $ns1 / 2}]
1484
set rn1 [expr {$midpoint + $goal / 2}]
1485
set rs1 [expr {$midpoint - $goal / 2}]
1488
set result [list $rn1 $rs1 $re1 $rw1]
1493
###############################################################################
1494
# map display procedures
1496
# draw map using png driver and open in canvas
1497
proc GRMap::drawmap { } {
1501
variable grcanmodified
1502
variable monitor_zooms
1503
variable previous_monitor
1507
set w [winfo width $grcan]
1508
set h [winfo height $grcan]
1510
# Get whether or not the canvas was modified or zoomed
1511
# grcanmodified has levels: 0 is none, 1 is zoom, 2 is geometry.
1512
# 1 doesn't require new setting in explore mode
1513
set mymodified $grcanmodified
1515
# Make sure grcanvas_h and grcanvas_w are correct
1516
if { $grcanvas_w != $w || $grcanvas_h != $h } {
1517
# Flag this as a modified canvas
1518
# Modified canvas is level 2!
1524
# Redo the driver settings if the geometry has changed or
1525
# if we weren't the previous monitor.
1526
if {$mymodified != 0 } {
1528
set previous_monitor "none"
1529
# The canvas or view has been modified
1530
# Redo the map settings to match the canvas
1531
GRMap::driversettings
1534
# Render all the layers
1535
GRMap::runprograms [expr {$mymodified != 0}]
1538
# Run the programs to clear the map and draw all of the layers
1539
proc GRMap::runprograms { mod } {
1553
variable gregionproj
1563
# First, switch to xy mapset
1564
GRMap::setxyenv $xymset $xyloc
1570
# Create a settings string to use with GRASS_WIND.
1571
# First get the current region values in normal number form (including decimal degrees)
1572
set values [GRMap::currentzoom]
1574
foreach attr $zoom_attrs value $values {
1575
lappend options "$attr=$value"
1578
# Now use the region values to get the region printed back out in -p format
1579
# including lat long now as dd:mm:ss
1580
if {![catch {open [concat "|g.region" "-up" $options "2> $devnull"] r} input]} {
1581
while {[gets $input line] >= 0} {
1582
if { [regexp -nocase {^([a-z]+)\:[ ]+(.*)$} $line trash key value] } {
1583
set parts($key) $value
1586
if {[catch {close $input} error]} {
1587
GmLib::errmsg $error [G_msg "Error setting region"]
1589
# Finally put this into wind file format to use with GRASS_REGION
1590
regexp -nocase {^.* (\(.*\))} $parts(projection) trash end
1591
set parts(projection) [string trim $parts(projection) $end]
1593
set gregion "projection:$parts(projection); zone:$parts(zone); north:$parts(north); south:$parts(south); east:$parts(east); west:$parts(west); e-w resol:$parts(ewres); n-s resol:$parts(nsres)"
1596
set GRMap::msg [G_msg "Please wait..."]
1597
$grmapframe showstatusbar progression
1600
# only use dynamic region for display geometry; use WIND for computational geometry
1601
set env(GRASS_REGION) $gregion
1603
# Setting the font really only needs to be done once per display start
1605
# display map for georectification
1606
if { $maptype == "rast" } {
1607
set cmd "d.rast map=$xymap"
1608
} elseif { $maptype == "vect" } {
1609
set cmd "d.vect map=$xymap"
1613
unset env(GRASS_REGION)
1622
image create photo grimg -file "$grfile"
1624
$grcan create image 0 0 -anchor nw \
1634
#draw GCP marks from GCP form
1635
for {set gcpnum 1} {$gcpnum < 51 } { incr gcpnum } {
1636
if {[$xy($gcpnum) get] != "" } {
1637
set xyfields [split [$xy($gcpnum) get] { }]
1638
set mapx [lindex $xyfields 0]
1639
set mapy [lindex $xyfields 1]
1640
set x [eval GRMap::mape2scrx $mapx]
1641
set y [eval GRMap::mapn2scry $mapy]
1642
GRMap::markgcp $x $y
1646
#draw GCP marks from any existing POINTS file
1647
set gcpfile "$xygdb/$xyloc/$xymset/group/$xygroup/POINTS"
1648
if {[file exists $gcpfile] } {
1651
catch {set pfile [open $gcpfile]}
1652
set points [read $pfile]
1653
if {[catch {close $pfile} error]} {
1654
GmLib::errmsg $error
1657
regsub -all {[ ]+} $points " " points
1658
set plines [split $points "\n"]
1659
foreach gcpline $plines {
1660
if {[string match {\#*} $gcpline]} continue
1661
if {$gcpline == "" } continue
1662
set gcpline [string trim $gcpline " "]
1663
set fields [split $gcpline { }]
1665
set mapx [lindex $fields 0]
1666
set mapy [lindex $fields 1]
1667
set x [eval GRMap::mape2scrx $mapx]
1668
set y [eval GRMap::mapn2scry $mapy]
1669
GRMap::markgcp $x $y
1677
set GRMap::msg [G_msg "Georectifying maps in $xygroup group"]
1679
$grmapframe showstatusbar status
1681
# Return to georectified mapset
1687
# set up driver geometry and settings
1688
proc GRMap::driversettings { } {
1696
variable monitor_zooms
1699
set driver_h $grcanvas_h
1700
set driver_w $grcanvas_w
1702
#set display environment
1703
# First, switch to xy mapset
1704
GRMap::setxyenv $xymset $xyloc
1706
set env(GRASS_WIDTH) "$driver_w"
1707
set env(GRASS_HEIGHT) "$driver_h"
1708
set env(GRASS_PNGFILE) "$grfile"
1709
set env(GRASS_BACKGROUNDCOLOR) "ffffff"
1710
set env(GRASS_TRANSPARENT) "FALSE"
1711
set env(GRASS_PNG_AUTO_WRITE) "TRUE"
1712
set env(GRASS_TRUECOLOR) "TRUE"
1714
# Return to georectified mapset
1719
###############################################################################
1720
# map display server
1721
# The job of these procedures is to make sure that:
1722
# 1: we are never running more than one update at once.
1723
# 2: we don't do exactly the same update multiple times.
1725
proc GRMap::display_server {} {
1726
variable redrawrequest
1733
if {$redrawrequest} {
1734
# Mark that this monitor no longer wants to be redrawn
1736
# Redraw the monitor canvas
1740
# Do me again in a short period of time.
1741
# vwait might be appropriate here
1742
after 100 GRMap::display_server
1745
# Request a redraw on a monitor
1746
proc GRMap::request_redraw {modified} {
1747
variable redrawrequest
1748
variable grcanmodified
1752
set grcanmodified $modified
1756
after idle GRMap::display_server
1758
###############################################################################
1760
proc GRMap::do_resize {} {
1766
# Get the actual width and height of the canvas
1767
set w [winfo width $grcan]
1768
set h [winfo height $grcan]
1770
# Only actually resize and redraw if the size is different
1771
if { $grcanvas_w != $w || $grcanvas_h != $h } {
1773
GRMap::request_redraw 1
1778
###############################################################################
1781
proc GRMap::erase { } {
1789
###############################################################################
1791
# stop display management tools
1792
proc GRMap::stoptool { } {
1802
bind $grcan <B1-Motion> ""
1803
bind $grcan <ButtonRelease-1> ""
1805
# reset status display to normal
1806
set GRMap::msg [G_msg "Georectifying maps in $xygroup group"]
1808
GRMap::restorecursor
1811
###############################################################################
1812
# set bindings for GCP selection tool
1813
proc GRMap::selector { } {
1815
variable grcoords_mov
1819
GRMap::setcursor "crosshair"
1821
bind $grcan <ButtonPress-1> {
1822
set eastcoord [eval GRMap::scrx2mape %x]
1823
set northcoord [eval GRMap::scry2mapn %y]
1824
set grcoords "$eastcoord $northcoord"
1825
GRMap::markgcp %x %y
1826
$xyentry delete 0 end
1827
$xyentry insert 0 $grcoords
1828
focus -force [tk_focusNext $xyentry]
1831
# Displays geographic coordinates in indicator window when cursor moved across canvas
1832
bind $grcan <Motion> {
1835
set eastcoord [eval GRMap::scrx2mape %x]
1836
set northcoord [eval GRMap::scry2mapn %y]
1837
set grcoords_mov "$eastcoord $northcoord"
1841
###############################################################################
1842
# mark ground control point
1843
proc GRMap::markgcp { x y } {
1845
# create gcp point on georectify canvas for each mouse click
1848
$grcan create line $x [expr $y-5] $x [expr $y+5] -tag gcpv \
1849
-fill DarkGreen -width 2 -tag "gcpvert"
1850
$grcan create line [expr $x-5] $y [expr $x+5] $y -tag gcph \
1851
-fill red -width 2 -tag "gcphoriz"
1855
###############################################################################
1856
# procedures for zooming and setting region
1858
# Get the current zoom region
1859
# Returns a list in zoom_attrs order (n s e w nsres ewres)
1860
proc GRMap::currentzoom { } {
1862
variable monitor_zooms
1868
# Fetch the current zoom settings
1870
foreach attr $zoom_attrs {
1871
lappend region $monitor_zooms(1,$attr)
1874
# Set the region to the smallest region no smaller than the canvas
1875
set grcanvas_ar [expr {1.0 * $grcanvas_w / $grcanvas_h}]
1876
set expanded_nsew [GRMap::shrinkwrap 1 [lrange $region 0 3] $grcanvas_ar]
1877
foreach {n s e w} $expanded_nsew {break}
1878
# Calculate the resolutions
1879
lappend expanded_nsew [expr {1.0 * ($n - $s) / $grcanvas_h}]
1880
lappend expanded_nsew [expr {1.0 * ($e - $w) / $grcanvas_w}]
1881
set region $expanded_nsew
1883
# region contains values for n s e w ewres nsres
1887
# Zoom or pan to new bounds in the zoom history
1888
# Arguments are either n s e w or n s e w nsres ewres
1889
proc GRMap::zoom_new { args} {
1890
variable monitor_zooms
1891
variable zoomhistories
1896
# Demote all of the zoom history
1897
for {set i $zoomhistories} {$i > 1} {incr i -1} {
1898
set iminus [expr {$i - 1}]
1899
foreach attr $zoom_attrs {
1900
catch {set monitor_zooms($i,$attr) $monitor_zooms($iminus,$attr)}
1904
# If cols and rows aren't present we just use what was already here.
1905
set present_attrs [lrange $zoom_attrs 0 [expr {[llength $args] - 1}]]
1907
foreach value $args attr $present_attrs {
1908
set monitor_zooms(1,$attr) $value
1913
# Zoom to the previous thing in the zoom history
1914
proc GRMap::zoom_previous {} {
1915
variable monitor_zooms
1916
variable zoomhistories
1921
# Remember the first monitor
1923
foreach attr $zoom_attrs {
1924
lappend old1 $monitor_zooms(1,$attr)
1927
# Promote all of the zoom history
1928
for {set i 1} {$i < $zoomhistories } {incr i} {
1929
set iplus [expr {$i + 1}]
1930
foreach attr $zoom_attrs {
1931
catch {set monitor_zooms($i,$attr) $monitor_zooms($iplus,$attr)}
1935
# Set the oldest thing in the history to where we just were
1936
foreach value $old1 attr $zoom_attrs {
1937
set monitor_zooms($zoomhistories,$attr) $value
1943
# Zoom to something loaded from a g.region command
1944
proc GRMap::zoom_gregion { args} {
1947
variable gregionproj
1951
# First, switch to xy mapset
1952
GRMap::setxyenv $xymset $xyloc
1954
if {![catch {open [concat "|g.region" "-up" $args "2> $devnull"] r} input]} {
1955
while {[gets $input line] >= 0} {
1956
set key [string trim [lindex [split $line ":"] 0]]
1957
set value [string trim [lindex [split $line ":"] 1]]
1958
set value [string trim $value "(UTM)"]
1959
set value [string trim $value "(x,y)"]
1960
set value [string trim $value]
1961
set parts($key) $value
1963
if {[catch {close $input} error]} {
1964
GmLib::errmsg $error ["Error setting region"]
1967
GRMap::zoom_new $parts(north) $parts(south) $parts(east) $parts(west) $parts(nsres) $parts(ewres)
1968
set gregionproj "proj: $parts(projection); zone: $parts(zone); "
1971
# Return to georectified mapset
1976
# zoom to extents and resolution of displayed map for georectifying
1977
proc GRMap::zoom_map { } {
1984
# set region to match map to georectify
1985
if { $maptype == "rast" } {
1986
GRMap::zoom_gregion [list "rast=$xymap"]
1987
} elseif { $maptype == "vect" } {
1988
GRMap::zoom_gregion [list "vect=$xymap"]
1992
GRMap::request_redraw 1
1998
proc GRMap::zoom_back { } {
2001
GRMap::zoom_previous
2003
GRMap::request_redraw 1
2007
###############################################################################
2008
# interactive zooming procedures
2010
proc GRMap::zoombind { zoom } {
2017
variable grcoords_mov
2019
# initialize zoom rectangle corners
2026
GRMap::setcursor "plus"
2029
set GRMap::msg [G_msg "Drag or click mouse to zoom"]
2030
} elseif {$zoom == -1} {
2031
set GRMap::msg [G_msg "Drag or click mouse to unzoom"]
2035
GRMap::markzoom %x %y
2037
bind $grcan <B1-Motion> {
2040
set eastcoord [eval GRMap::scrx2mape %x]
2041
set northcoord [eval GRMap::scry2mapn %y]
2042
set grcoords_mov "$eastcoord $northcoord"
2043
GRMap::drawzoom %x %y
2045
bind $grcan <ButtonRelease-1> "GRMap::zoomregion $zoom"
2049
# start zoom rectangle
2050
proc GRMap::markzoom { x y} {
2057
# initialize corners
2062
set areaX1 [$grcan canvasx $x]
2063
set areaY1 [$grcan canvasy $y]
2067
# draw zoom rectangle
2068
proc GRMap::drawzoom { x y } {
2075
set xc [$grcan canvasx $x]
2076
set yc [$grcan canvasy $y]
2078
if {($areaX1 != $xc) && ($areaY1 != $yc)} {
2080
$grcan addtag area withtag \
2081
[$grcan create rect $areaX1 $areaY1 $xc $yc \
2082
-outline yellow -width 2]
2090
proc GRMap::zoomregion { zoom } {
2094
variable monitor_zooms
2109
# get display extents in geographic coordinates
2110
set dispnorth [scry2mapn 0]
2111
set dispsouth [scry2mapn $grcanvas_h]
2112
set dispeast [scrx2mape $grcanvas_w]
2113
set dispwest [scrx2mape 0]
2115
# get zoom rectangle extents in geographic coordinates
2116
if { $areaX2 < $areaX1 } {
2124
if { $areaY2 < $areaY1 } {
2132
set north [scry2mapn $ctop]
2133
set south [scry2mapn $cbottom]
2134
set east [scrx2mape $cright]
2135
set west [scrx2mape $cleft]
2136
# (this is all you need to zoom in with box)
2139
# if click and no drag, zoom in or out by fraction of original area and center on the click spot
2140
if {($areaX2 == 0) && ($areaY2 == 0)} {set clickzoom 1}
2141
# get first click location in map coordinates for recentering with 1-click zooming
2142
set newcenter_n [scry2mapn $areaY1]
2143
set newcenter_e [scrx2mape $areaX1]
2145
# get current region extents for box zooming out and recentering
2146
foreach {map_n map_s map_e map_w nsres ewres} [GRMap::currentzoom] {break}
2148
# get original map center for recentering after 1-click zooming
2149
set oldcenter_n [expr $map_s + ($map_n - $map_s)/2]
2150
set oldcenter_e [expr $map_w + ($map_e - $map_w)/2]
2152
# set shift for recentering after 1-click zooming
2153
set shift_n [expr $newcenter_n - $oldcenter_n]
2154
set shift_e [expr $newcenter_e - $oldcenter_e]
2156
# 1-click zooming--zooms in or out by function of square root of 2 and
2157
# recenters region in display window at spot clicked
2158
if {$clickzoom == 1} {
2159
# calculate amount to zoom in or out in geographic distance
2160
set nsscale [expr (($dispnorth - $dispsouth) - ($dispnorth - $dispsouth)/sqrt(2))/2]
2161
set ewscale [expr (($dispeast - $dispwest) - ($dispeast - $dispwest)/sqrt(2))/2]
2164
set north [expr {$dispnorth - $nsscale + $shift_n}]
2165
set south [expr {$dispsouth + $nsscale + $shift_n}]
2166
set east [expr {$dispeast - $ewscale + $shift_e}]
2167
set west [expr {$dispwest + $ewscale + $shift_e}]
2168
} elseif {$zoom == -1} {
2170
set north [expr {$dispnorth + $nsscale + $shift_n}]
2171
set south [expr {$dispsouth - $nsscale + $shift_n}]
2172
set east [expr {$dispeast + $ewscale + $shift_e}]
2173
set west [expr {$dispwest - $ewscale + $shift_e}]
2178
# box determines zoom out proportion, longest box dimension determines zoom,
2179
# and box center becomes region center. Zoom out relative to the geographic
2180
# extents of the display rather than the current region to deal with mismatches
2181
# between geometry of region and display window.
2182
if { $zoom == -1 && $clickzoom == 0} {
2183
# Calculate the box geometry--to be used for new region geometry
2184
set box_ns [expr $north-$south]
2185
set box_ew [expr $east-$west]
2186
# calcuate aspect ratio for zoom box
2187
set box_aspect [expr $box_ns/$box_ew]
2188
# calculate zoomout ratio for longest box dimension
2189
if { $box_ns > $box_ew } {
2190
set zoomratio [expr ($dispnorth - $dispsouth)/$box_ns]
2191
set new_ns [expr ($dispnorth - $dispsouth) * $zoomratio]
2192
set new_ew [expr $new_ns / $box_aspect]
2194
set zoomratio [expr ($dispeast - $dispwest)/$box_ew]
2195
set new_ew [expr ($dispeast - $dispwest) * $zoomratio]
2196
set new_ns [expr $new_ew * $box_aspect]
2199
# get zoom-out box center
2200
set boxcenter_n [expr $south + (($north - $south)/2)]
2201
set boxcenter_e [expr $west + (($east - $west)/2)]
2203
# zoom out to new extents
2204
set north [expr $boxcenter_n + ($new_ns/2)]
2205
set south [expr $boxcenter_n - ($new_ns/2)]
2206
set east [expr $boxcenter_e + ($new_ew/2)]
2207
set west [expr $boxcenter_e - ($new_ew/2)]
2210
GRMap::zoom_new $north $south $east $west $nsres $ewres
2215
GRMap::request_redraw 1
2220
###############################################################################
2221
#procedures for panning
2224
proc GRMap::panbind { } {
2227
variable grcoords_mov
2229
set GRMap::msg [G_msg "Drag with mouse to pan"]
2231
GRMap::setcursor "hand2"
2233
bind $grcan <1> {GRMap::startpan %x %y}
2234
bind $grcan <B1-Motion> {
2237
set eastcoord [eval GRMap::scrx2mape %x]
2238
set northcoord [eval GRMap::scry2mapn %y]
2239
set grcoords_mov "$eastcoord $northcoord"
2240
GRMap::dragpan %x %y
2242
bind $grcan <ButtonRelease-1> {
2248
proc GRMap::startpan { x y} {
2257
set start_x [$grcan canvasx $x]
2258
set start_y [$grcan canvasy $y]
2266
proc GRMap::dragpan { x y} {
2275
set to_x [$grcan canvasx $x]
2276
set to_y [$grcan canvasy $y]
2277
$grcan move current [expr {$to_x-$start_x}] [expr {$to_y-$start_y}]
2283
proc GRMap::pan { } {
2291
variable monitor_zooms
2299
# get map coordinate shift
2300
set from_e [scrx2mape $from_x]
2301
set from_n [scry2mapn $from_y]
2302
set to_e [scrx2mape $to_x]
2303
set to_n [scry2mapn $to_y]
2305
# get region extents
2306
foreach {map_n map_s map_e map_w} [GRMap::currentzoom] {break}
2308
# set new region extents
2309
set north [expr {$map_n - ($to_n - $from_n)}]
2310
set south [expr {$map_s - ($to_n - $from_n)}]
2311
set east [expr {$map_e - ($to_e - $from_e)}]
2312
set west [expr {$map_w - ($to_e - $from_e)}]
2314
# reset region and redraw map
2315
GRMap::zoom_new $north $south $east $west
2318
GRMap::request_redraw 1
2321
###############################################################################
2323
proc GRMap::setcursor { ctype } {
2326
$grcan configure -cursor $ctype
2330
proc GRMap::restorecursor {} {
2334
$grcan configure -cursor $grcursor
2338
###############################################################################
2340
# Set up initial variables for screen to map conversion
2341
proc GRMap::coordconv { } {
2355
variable map2scrx_conv
2356
variable map2scry_conv
2359
variable monitor_zooms
2361
# get region extents
2362
foreach {map_n map_s map_e map_w} [GRMap::currentzoom] {break}
2364
# calculate dimensions
2366
set map_n [expr {1.0*($map_n)}]
2367
set map_s [expr {1.0*($map_s)}]
2368
set map_e [expr {1.0*($map_e)}]
2369
set map_w [expr {1.0*($map_w)}]
2371
set map_ew [expr {$map_e - $map_w}]
2372
set map_ns [expr {$map_n - $map_s}]
2375
# get current screen geometry
2376
if { [info exists "grimg"] } {
2377
set scr_ew [image width "grimg"]
2378
set scr_ns [image height "grimg"]
2379
set scr_e [image width "grimg"]
2380
set scr_s [image height "grimg"]
2382
set scr_ew $grcanvas_w
2383
set scr_ns $grcanvas_h
2384
set scr_e $grcanvas_w
2385
set scr_s $grcanvas_h
2391
# calculate conversion factors. Note screen is from L->R, T->B but map
2392
# is from L->R, B->T
2394
set map2scrx_conv [expr {$scr_ew / $map_ew}]
2395
set map2scry_conv [expr {$scr_ns / $map_ns}]
2397
# calculate screen dimensions and offsets
2399
if { $map2scrx_conv > $map2scry_conv } {
2400
set map2scrx_conv $map2scry_conv
2402
set map2scry_conv $map2scrx_conv
2407
###############################################################################
2410
# screen to map and map to screen conversion procedures
2412
# map north to screen y
2413
proc GRMap::mapn2scry { north } {
2416
variable map2scry_conv
2418
return [expr {$scr_n + (($map_n - $north) * $map2scry_conv)}]
2421
# map east to screen x
2422
proc GRMap::mape2scrx { east } {
2425
variable map2scrx_conv
2427
return [expr {$scr_w + (($east - $map_w) * $map2scrx_conv)}]
2431
# screen y to map north
2432
proc GRMap::scry2mapn { y } {
2435
variable map2scry_conv
2437
return [expr {$map_n - (($y - $scr_n) / $map2scry_conv)}]
2440
# screen x to map east
2441
proc GRMap::scrx2mape { x } {
2444
variable map2scrx_conv
2446
return [expr {$map_w + (($x - $scr_w) / $map2scrx_conv)}]
2450
###############################################################################
2451
# cleanup procedure on closing window
2452
proc GRMap::cleanup { } {
2455
if { [winfo exists .gcpwin] } { destroy .gcpwin }
2456
if { [winfo exists .mapgrcan] } { destroy .mapgrcan }
2458
for {set gcpnum 1} {$gcpnum < 51 } { incr gcpnum } {
2459
if {[info exists xy($gcpnum)]} {
2464
# reset to original location and mapset
2469
###############################################################################
added
removed
gui/tcltk/gis.m/georect.tcl
