tcl/viewer.tcl

   1 # High-level operation with layers
   2 #
   3 #
   4
   5 proc open_layer {filename} {
   6 global layerFile
   7 if ![file exists $filename] {
   8    if [file exist $filename.epp] {
   9       append filename .epp
  10    } else {
  11      tk_messageBox -message "File $filename doesn't exists" -type ok
  12    }
  13 }
  14 if {[file extension $filename]==".epp"} {
  15
  16 set basename [file rootname $filename]
  17 set layer [layer create raster -file $filename -title $basename ]
  18
  19 if [file exists $basename.leg] {
  20    $layer configure -legfile $basename.leg
  21    set legend [$layer cget -legend]
  22    if [string length [$legend title]] {
  23     $layer configure -title [$legend title]
  24    }
  25 }
  26 if [file exists $basename.clr] {
  27    $layer configure -palfile $basename.clr
  28 }
  29
  30 } else {
  31  set layer [uplevel #0 source [list $filename]]
  32  set layerFile($layer) $filename
  33 }
  34  return $layer
  35 }
  36
  37
  38 #if ![llength $argv] {
  39 #  set argv [tk_getOpenFile -filetypes {{"Epp files" *.epp}
  40 #                                       {"fGIS layers" *.lay}}]
  41 #}
  42
  43 proc show_layer {layer} {
  44   global planchet
  45   if ![string length $layer] return
  46   wm title . "Mapview: [$layer title]"
  47   $planchet show $layer -base
  48 }
  49
  50 proc add_layer {{file {}}} {
  51   global planchet
  52   if ![string length $file] {
  53   set file [tk_getOpenFile -filetypes {{"Epp files" *.epp}
  54                                        {"fGIS layers" *.lay}}]
  55  }
  56   if ![string length $file] return
  57   set layer [open_layer $file]
  58   if ![llength [$planchet layers]] {
  59     show_layer $layer
  60   }
  61   $planchet look add $layer
  62   catch {.menu.file.m entryconfig "Save..." -state normal}
  63   catch {.menu.file.m entryconfig "Close..." -state normal}
  64   foreach i {1 2 3} {
  65     catch {.menu.layer.m entryconfig $i -state normal}
  66   }
  67
  68 }
  69
  70 proc select_layers {} {
  71   global planchet
  72   foreach layer [$planchet look list] {
  73     set on($layer) 1
  74   }
  75   catch {destroy .chooser}
  76   toplevel .chooser
  77   wm title .chooser "Select layer"
  78   frame .chooser.t
  79   listbox .chooser.t.l -width 40 -height 10 -yscrollcommand ".chooser.t.y set" -selectmode extended
  80   scrollbar .chooser.t.y -orient vert -command ".chooser.t.l yview"
  81   pack .chooser.t.l .chooser.t.y -side left  -fill both -expand y
  82   pack .chooser.t -fill both -expand y
  83   frame .chooser.b
  84   button .chooser.b.ok -padx 10 -text "Apply" -command {setup_look .chooser.t.l}
  85   button .chooser.b.cancel -padx 10 -text "Close" -command {destroy .chooser}
  86   pack .chooser.b.ok -side left
  87   pack .chooser.b.cancel -side left
  88   pack .chooser.b
  89   set box .chooser.t.l
  90   foreach layer [layer names] {
  91      set n [$box size]
  92      $box insert end [$layer title]
  93      if [info exist on($layer)] {
  94        $box selection set $n
  95      }
  96   }
  97
  98 }
  99
 100 proc setup_look {box} {
 101   global platnchet
 102   set layers [layer names]
 103   $planchet look remove all
 104   foreach n [$box curselection] {
 105     $planchet look add [lindex $layers $n]
 106   }
 107 }
 108
 109 proc select_layer {} {
 110   global planchet
 111   catch {destroy .chooser}
 112   toplevel .chooser
 113   wm title .chooser "Select layer"
 114   wm transient .chooser
 115   frame .chooser.t
 116   bind .chooser <Destroy> {set selectedLayer ""}
 117   listbox .chooser.t.l -width 40 -height 10 -yscrollcommand ".chooser.t.y set" -exportselection false
 118   scrollbar .chooser.t.y -orient vert -command ".chooser.t.l yview"
 119   pack .chooser.t.l .chooser.t.y -side left  -fill both -expand y
 120   pack .chooser.t -fill both -expand y
 121   frame .chooser.b
 122   bind .chooser.t.l <Double-1> {set selectedLayer [.chooser.t.l index active]}
 123   button .chooser.b.ok -padx 10 -text "Ok" -command {set selectedLayer [.chooser.t.l curselection]}
 124   button .chooser.b.cancel -padx 10 -text "Cancel" -command {set selectedLayer ""}
 125   pack .chooser.b.ok -side left
 126   pack .chooser.b.cancel -side left
 127   pack .chooser.b
 128   set box .chooser.t.l
 129   set current [lindex [$planchet layers] 0]
 130   foreach layer [layer names] {
 131      set n [$box size]
 132      $box insert end [$layer title]
 133      if {"$layer"=="$current"} {
 134        $box selection set $n
 135      }
 136   }
 137   global selectedLayer
 138   vwait selectedLayer
 139   if { $selectedLayer == ""} {
 140     set result ""
 141   } else {
 142     set result [lindex [layer names] $selectedLayer]
 143   }
 144   catch {destroy .chooser}
 145   return $result
 146 }
 147
 148 proc close_layer {layer} {
 149   global modifiedLayers planchet
 150   if ![string length $layer] return
 151   if [info exist modifiedLayers($layer)] {
 152      switch -exact -- [tk_messageBox -title "Warning" -message\
 153          "This layer was modified. Save it?" -type yesnocancel] {
 154      yes {save_layer $layer}
 155      no  {}
 156      cancel {return}
 157      }
 158   }
 159
 160   if {[llength [layer names]]==1} {
 161       if {[tk_messageBox -title "Warning" -message "This is a last layer.\
 162        Closing it would cause mapview to exit. Proceed?"\
 163        -type yesno]=="no"} return else exit
 164
 165   }
 166   catch {$planchet look remove $layer}
 167   $layer delete
 168   if ![llength [$planchet layers]] {
 169      show_layer [lindex [layer names] 0]
 170   }
 171 }
 172
 173 proc save_layer {layer} {
 174 global layerFile layerModified
 175 if ![info exist layerFile($layer)] {
 176   regsub -all "\[\t ]+" [$layer title] "_" filename
 177   set filename [tk_getSaveFile -defaultextension ".lay" -initialfile $filename.lay]
 178   if ![string length $filename] return
 179   set layerFile($layer) $filename
 180 }
 181 if [file exists $layerFile($layer)] {
 182    set bakname "[file rootname $layerFile].bak"
 183    if [file exists $bakname] {
 184        file delete $bakname
 185    }
 186    file rename $layerFile($layer) $bakname
 187 }
 188 set f [open $layerFile($layer) w]
 189 puts $f [$layer dump]
 190 close $f
 191 catch {unset layerModified($layer)}
 192 }
 193
 194 proc confirmExit {} {
 195   global argv0
 196    if {[tk_messageBox -title confirm -type yesno -message "Exit $argv0. Are
 197    you sure"]=="yes"} {
 198       destroy .
 199    }
 200 }