tcl/viewer.tcl

   1 #!/usr/bin/wish
   2 ##
   3 ## $Id: viewer.tcl,v 1.2 2003-01-08 15:52:45 dron Exp $
   4 ##
   5 ## Project:  fGIS Tcl library
   6 ## Purpose:  High-level operation with layers
   7 ##
   8 ##############################################################################
   9 ##
  10 ## Copyright (C) 1997, Victor Wagner <vitus@ice.ru>
  11 ## Copyright (C) 2002, Andrey Kiselev <dron@remotesensing.org>
  12 ##
  13 ## This program is free software; you can redistribute it and/or modify
  14 ## it under the terms of the GNU General Public License as published by
  15 ## the Free Software Foundation; either version 2, or (at your option)
  16 ## any later version.
  17 ##
  18 ## This program is distributed in the hope that it will be useful,
  19 ## but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ## GNU General Public License for more details.
  22 ##
  23 ## You should have received a copy of the GNU General Public License
  24 ## along with this program; if not, write to the Free Software
  25 ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
  26 ## USA.
  27
  28 proc open_layer {filename} {
  29 global layerFile
  30 if ![file exists $filename] {
  31    if [file exist $filename.epp] {
  32       append filename .epp
  33    } else {
  34      tk_messageBox -message "File $filename doesn't exists" -type ok
  35    }
  36 }
  37 if {[file extension $filename]==".epp"} {
  38
  39 set basename [file rootname $filename]
  40 set layer [layer create raster -file $filename -title $basename ]
  41
  42 if [file exists $basename.leg] {
  43    $layer configure -legfile $basename.leg
  44    set legend [$layer cget -legend]
  45    if [string length [$legend title]] {
  46     $layer configure -title [$legend title]
  47    }
  48 }
  49 if [file exists $basename.clr] {
  50    $layer configure -palfile $basename.clr
  51 }
  52
  53 } else {
  54  set layer [uplevel #0 source [list $filename]]
  55  set layerFile($layer) $filename
  56 }
  57  return $layer
  58 }
  59
  60
  61 #if ![llength $argv] {
  62 #  set argv [tk_getOpenFile -filetypes {{"Epp files" *.epp}
  63 #                                       {"fGIS layers" *.lay}}]
  64 #}
  65
  66 proc show_layer {layer} {
  67   global planchet
  68   if ![string length $layer] return
  69   wm title . "Mapview: [$layer title]"
  70   $planchet show $layer -base
  71 }
  72
  73 proc add_layer {{file {}}} {
  74   global planchet
  75   if ![string length $file] {
  76   set file [tk_getOpenFile -filetypes {{"Epp files" *.epp}
  77                                        {"fGIS layers" *.lay}}]
  78  }
  79   if ![string length $file] return
  80   set layer [open_layer $file]
  81   if ![llength [$planchet layers]] {
  82     show_layer $layer
  83   }
  84   $planchet look add $layer
  85   catch {.menu.file.m entryconfig "Save..." -state normal}
  86   catch {.menu.file.m entryconfig "Close..." -state normal}
  87   foreach i {1 2 3} {
  88     catch {.menu.layer.m entryconfig $i -state normal}
  89   }
  90
  91 }
  92
  93 proc select_layers {} {
  94   global planchet
  95   foreach layer [$planchet look list] {
  96     set on($layer) 1
  97   }
  98   catch {destroy .chooser}
  99   toplevel .chooser
 100   wm title .chooser "Select layer"
 101   frame .chooser.t
 102   listbox .chooser.t.l -width 40 -height 10 -yscrollcommand ".chooser.t.y set" -selectmode extended
 103   scrollbar .chooser.t.y -orient vert -command ".chooser.t.l yview"
 104   pack .chooser.t.l .chooser.t.y -side left  -fill both -expand y
 105   pack .chooser.t -fill both -expand y
 106   frame .chooser.b
 107   button .chooser.b.ok -padx 10 -text "Apply" -command {setup_look .chooser.t.l}
 108   button .chooser.b.cancel -padx 10 -text "Close" -command {destroy .chooser}
 109   pack .chooser.b.ok -side left
 110   pack .chooser.b.cancel -side left
 111   pack .chooser.b
 112   set box .chooser.t.l
 113   foreach layer [layer names] {
 114      set n [$box size]
 115      $box insert end [$layer title]
 116      if [info exist on($layer)] {
 117        $box selection set $n
 118      }
 119   }
 120
 121 }
 122
 123 proc setup_look {box} {
 124   global planchet
 125   set layers [layer names]
 126   $planchet look remove all
 127   foreach n [$box curselection] {
 128     $planchet look add [lindex $layers $n]
 129   }
 130 }
 131
 132 proc select_layer {} {
 133   global planchet
 134   catch {destroy .chooser}
 135   toplevel .chooser
 136   wm title .chooser "Select layer"
 137   wm transient .chooser
 138   frame .chooser.t
 139   bind .chooser <Destroy> {set selectedLayer ""}
 140   listbox .chooser.t.l -width 40 -height 10 -yscrollcommand ".chooser.t.y set" -exportselection false
 141   scrollbar .chooser.t.y -orient vert -command ".chooser.t.l yview"
 142   pack .chooser.t.l .chooser.t.y -side left  -fill both -expand y
 143   pack .chooser.t -fill both -expand y
 144   frame .chooser.b
 145   bind .chooser.t.l <Double-1> {set selectedLayer [.chooser.t.l index active]}
 146   button .chooser.b.ok -padx 10 -text "Ok" -command {set selectedLayer [.chooser.t.l curselection]}
 147   button .chooser.b.cancel -padx 10 -text "Cancel" -command {set selectedLayer ""}
 148   pack .chooser.b.ok -side left
 149   pack .chooser.b.cancel -side left
 150   pack .chooser.b
 151   set box .chooser.t.l
 152   set current [lindex [$planchet layers] 0]
 153   foreach layer [layer names] {
 154      set n [$box size]
 155      $box insert end [$layer title]
 156      if {"$layer"=="$current"} {
 157        $box selection set $n
 158      }
 159   }
 160   global selectedLayer
 161   vwait selectedLayer
 162   if { $selectedLayer == ""} {
 163     set result ""
 164   } else {
 165     set result [lindex [layer names] $selectedLayer]
 166   }
 167   catch {destroy .chooser}
 168   return $result
 169 }
 170
 171 proc close_layer {layer} {
 172   global modifiedLayers planchet
 173   if ![string length $layer] return
 174   if [info exist modifiedLayers($layer)] {
 175      switch -exact -- [tk_messageBox -title "Warning" -message\
 176          "This layer was modified. Save it?" -type yesnocancel] {
 177      yes {save_layer $layer}
 178      no  {}
 179      cancel {return}
 180      }
 181   }
 182
 183   if {[llength [layer names]]==1} {
 184       if {[tk_messageBox -title "Warning" -message "This is a last layer.\
 185        Closing it would cause mapview to exit. Proceed?"\
 186        -type yesno]=="no"} return else exit
 187
 188   }
 189   catch {$planchet look remove $layer}
 190   $layer delete
 191   if ![llength [$planchet layers]] {
 192      show_layer [lindex [layer names] 0]
 193   }
 194 }
 195
 196 proc save_layer {layer} {
 197 global layerFile layerModified
 198 if ![info exist layerFile($layer)] {
 199   regsub -all "\[\t ]+" [$layer title] "_" filename
 200   set filename [tk_getSaveFile -defaultextension ".lay" -initialfile $filename.lay]
 201   if ![string length $filename] return
 202   set layerFile($layer) $filename
 203 }
 204 if [file exists $layerFile($layer)] {
 205    set bakname "[file rootname $layerFile].bak"
 206    if [file exists $bakname] {
 207        file delete $bakname
 208    }
 209    file rename $layerFile($layer) $bakname
 210 }
 211 set f [open $layerFile($layer) w]
 212 puts $f [$layer dump]
 213 close $f
 214 catch {unset layerModified($layer)}
 215 }
 216
 217 proc confirmExit {} {
 218   global argv0
 219    if {[tk_messageBox -title confirm -type yesno -message "Exit $argv0. Are
 220    you sure"]=="yes"} {
 221       destroy .
 222    }
 223 }