]> www.wagner.pp.ru Git - oss/fgis.git/blob - tcl/planchet.tcl
The second attempt to automate building :-) A lot of work here should be
[oss/fgis.git] / tcl / planchet.tcl
1 #
2 # planchet.tcl 
3 # definition of planchet widget.
4 #
5 # This file is part of fGIS tcl library
6 # Copyright (c) by SoftWeyr, 1997
7 #
8
9 #
10 # Class options
11
12 #
13 array set Planchet {
14 legbox {}
15 zoombutton {}
16 unzoombuttons {}
17 shiftbuttons {{} {} {} {}}
18 statusline {}
19 scalevar {}
20 rulerpos {1c -1c}
21 projection {}
22 lookwidth 200
23 resizable 1
24 }
25 #this options are got from application defaults
26 array set Planchet [list\
27 coordformat $fgis(coordformat)\
28 orient $fgis(orient)\
29 shiftfactor $fgis(shift_factor)\
30 ]
31
32 # This options added here to make getopt eat up them, if they specified, and
33 # so they would never passed to canvas command, so planchet would effectively
34 # ignore them
35 array set Planchet {
36 borderwidth 0
37 bd 0
38 highlightthickness 0
39 }
40 #
41 # bindings
42 #
43
44 bind Planchet <Configure> "fgisPlanchet:resize %W"
45 bind Planchet <Destroy>  "fgisPlanchet:destroy %W"
46 bind Planchet <Button-3> "fgisPlanchet:look %W %x %y"
47 bind Planchet <Any-Leave> "fgisPlanchet_setstatus %W {} {}"
48 bind Planchet <Any-Enter> "fgisPlanchet:setstatus %W %x %y"
49 bind Planchet <Any-Motion> "fgisPlanchet:setstatus %W %x %y"
50 bind LookToplevel <ButtonRelease-3> "fgisPlanchet:hidelook %W"
51 bind LookToplevel <Button-1> "fgisPlanchet:hidelook %W"
52 bind Zoom <Any-Motion> break
53 bind Zoom <Button-1> "fgisPlanchet_zoom %W %x %y;break"
54 bind Zoom <Button-3> "fgisPlanchet_zoom %W cancel;break"
55 bind Zoom <Key-Escape> "fgisPlanchet_zoom %W cancel;break"
56 bind Zoom <Any-Leave> "break"
57 bind Zoom <Any-Enter> "break"
58 #
59 # create planchet widget
60 #
61 #
62 proc planchet {w args} {
63 upvar \#0 $w data
64 global Planchet
65 #parse options
66 array set data [array get Planchet]
67 set data(default) {}
68 if [catch {getopt data $args} err] {
69   unset data
70   return -code error $err
71
72 set restargs $data(default)
73 unset data(default)
74 #check helper widgets, if available
75 foreach t {legbox statusline shiftbuttons unzoombuttons zoombutton} {
76    if [catch {fgisSetHelper $w $t $data($t)} err] {
77         unset data
78         return -code error $err
79     }
80 }
81 #correct value of "resizable" options
82 if [checkbooleanopt data(resizable) err] {
83    return -code error $err
84 }   
85 #create canvas
86 if [catch {eval canvas [list $w] $restargs -bd 0\
87          -highlightthickness 0} err] {
88    unset data
89    return -code error $err
90 }
91 bindtags $w [list $w Planchet [winfo parent $w] all]
92 #create widget command
93 set data(cmd) .$w
94 rename $w $data(cmd)
95 ;proc $w args "eval fgisPlanchet:eval [list $w] \$args"
96 # create look widnow
97
98 set data(lookToplevel) [toplevel $w.look -class LookToplevel\
99          -relief raised -bd 3]
100 set data(lookLabel) [label $w.look.label -wraplength $data(lookwidth)\
101     -justify left]
102 pack $data(lookLabel)
103 wm overrideredirect $data(lookToplevel) y
104 wm transient $data(lookToplevel) $w
105 wm positionfrom $data(lookToplevel) program
106 wm withdraw $data(lookToplevel)
107 # fill placeholders for layer information
108 array set data {
109 lookable {}
110 overlays {}
111 base {}
112 limits {}
113 zoom {}
114 }
115 return $w
116 }
117
118 #
119 # fgisPlanchet:eval 
120 # -evaluates planchet widget command
121 #
122 ;proc fgisPlanchet:eval {w option args} {
123  upvar \#0 $w data
124   if [string match {} [set arg [info command fgisPlanchet_$option]]] {
125       set arg [info command fgiPlanchet_$option*]
126   }
127   switch -exact [llength $arg] {
128       0 { if [catch {uplevel [list $data(cmd) $option] $args} err] {
129             return -code error $err
130           } else {
131             return $err
132           }
133       }
134       1 {return [uplevel $arg [list $w] $args] }
135       default {
136            return -code error "ambiquous option \"$option\""
137       }
138   }
139 }
140
141 #
142 # fgisPlanchet:destroy 
143 # destroys planchet
144 #
145
146 ;proc fgisPlanchet:destroy w {
147   upvar \#0 $w data
148   foreach layer [linsert $data(overlays) end $data(base)] {
149     if [string length $layer] {$layer  hide $w}
150   }
151   catch {rename $w {}}
152   #catch {rename $data(cmd) $w}
153   catch {unset data}
154   return
155 }
156 #
157 # releases grab and hides look window
158 #
159 ;proc fgisPlanchet:hidelook {w} {
160   catch {grab release $w}
161   wm withdraw $w
162 }
163 #
164 # Given point in canvas coordinates, displays window with content
165 # of current layers
166 #
167 ;proc fgisPlanchet:look {w x y} {
168     upvar \#0 $w data
169     set text [join [fgisPlanchet_look $w \
170             [fgisPlanchet_mapx $w $x] [fgisPlanchet_mapy $w $y] -titled] "\n"]
171     if ![string length $text] {
172         set text "No info for this point"
173     }   
174     $data(lookLabel) configure -text $text
175     set rootx [expr [winfo rootx $w]+$x+5]
176     if {$rootx>[winfo screenwidth $w]} {
177         set rootx [expr $rootx-10-[winfo reqwidth $data(lookToplevel)]]
178     }
179     set rooty [expr [winfo rooty $w]+$y+5]
180     if {$rooty>[winfo screenwidth $w]} {
181         set rooty [expr $rooty-10-[winfo reqheight $data(lookToplevel)]]
182     }
183     wm geometry $data(lookToplevel)  +$rootx+$rooty
184     wm deiconify $data(lookToplevel)
185     raise $data(lookToplevel)
186     grab $data(lookToplevel)
187 }
188 #
189 # User visible implementation of look. Can be invoked as look planchet
190 # subcommand. Gets two map-coordinates and returns list of active layers
191 # Forms
192 # $planchet look x y ?-titled|-list?
193 # $planchet look add $layer
194 # $planchet look remove pattern 
195 # $planchet look remove all
196 # $planchet look list ?pattern?
197 # legend text as layer value x y -titled returns
198 #
199 # Layers that return an empty string are ignored
200 #
201 ;proc fgisPlanchet_look {w x {y {}} {flag -list}} {
202    upvar \#0 $w data
203    switch -exact -- $x {
204       add { 
205           if ![string length $y] {
206               return -code error "Wrong # args. Should be $w look add layer"
207           }
208           if ![layer exists $y] {
209               return -code error "Layer \"$y\" doesn't exist"
210           }
211           if ![$y info lookable] {
212               return -code error "Layer \"$y\" is not lookable"
213           }
214           if [lsearch -exact $data(lookable) $y]!=-1 {
215               return -code error "Layer \"$y\" is already in look list of $w"
216           }    
217           lappend data(lookable) $y
218       }
219       remove {
220          if ![string length $y] {
221             return -code error\
222                   "Wrong # args. Should be $w look remove pattern"
223          }
224          if {"$y"=="all"} {
225              set data(lookable) {}
226          } else {
227            if [lsearch -glob $data(lookable) $y]==-1 {
228                return -code error "No layers match pattern \"$y\""
229            }
230            while {[set index [lsearch -glob $data(lookable) $y]]!=-1} {
231               set data(lookable) [lreplace $data(lookable) $index $index]
232            }
233          }
234       }
235       list {
236          set result {}
237          if [string match {} $y] {set y *}
238          foreach l $data(lookable) {
239             if [string match $y $l] {
240                lappend result $l
241             }
242          }   
243          return $result
244       } 
245       default {
246           set result {}
247           foreach layer $data(lookable) {
248              lappend result [$layer value $x $y $flag]
249           }
250           return $result
251       }      
252    }   
253 }
254 #
255 # Displays mouse coordinates in window.
256 # Recalculates pixels to meters and calls $w setstatus
257 # If no coordinate defined, displays "No coords"
258 #
259
260 ;proc fgisPlanchet:setstatus {w x y}  {
261 upvar \#0 $w data
262 if ![llength $data(limits)] {
263    fgisPlanchet_setstatus $w "No coordinates defined"
264 } else {
265   fgisPlanchet_setstatus $w [fgisPlanchet_mapx $w $x] [fgisPlanchet_mapy $w $y]
266 }
267 }
268
269 #
270 # Changes content of status window, if available
271 # possible variants setstatus {} - clears status line
272 # setstatus msg - displays $msg
273 # setstatus x y - displays coordinates. Map coordinates, not screen!
274 ;proc fgisPlanchet_setstatus {w x {y {}}} {
275 upvar \#0 $w data 
276 if ![string length $data(statusline)] {
277    return
278 }
279 if ![string length $y] {
280   $data(statusline) configure -text $x
281 } elseif ![string length $data(projection)] {
282   $data(statusline) configure -text [format $data(coordformat) $x $y]
283 } else {
284   $data(statusline) configure -text [$data(projection) format $x $y]
285 }
286 }
287
288 #
289 # intercepts widget configure command
290
291 #
292 ;proc fgisPlanchet_configure {w args} {
293 upvar \#0 $w data
294 if ![llength opt] {
295    return [eval $data(cmd) configure]
296 }
297 array set opt [list\
298     legbox [list fgisSetHelper $w legbox]\
299     zoombutton [list fgisSetHelper $w zoombutton ]\
300     unzoombuttons [list fgisSetHelper $w unzoombuttons ]\
301     shiftbuttons [list fgisSetHelper $w shiftbuttons]\
302     statusline [list fgisSetHelper $w statusline]\
303     scalevar {set data(scalevar)}\
304     rulerpos [list fgisPlanchet:ruler $w]\
305     projection {set data(projection)}\
306     lookwidth [list $data(lookLabel) configure -wraplength]\
307     coordformat "set data(coordformat)"\
308     orient "set data(orient)"\
309     shiftfactor "set data(shiftfactor)"\
310     borderwidth {#}\
311     bd 0\
312     highlightthickness {#}\
313     default "lappend restargs"\
314 ]
315 set restargs {}
316 if [catch {handleopt opt $args} res] {
317     return -code error $res
318 }
319 if [llength $restargs] {
320     if [catch {eval $data(cmd) configure $restargs}] {
321       return -code error $res
322     } 
323 }
324 }
325 #
326 # Installs link to helper widget.
327 # Strictly internal use
328 #
329 ;proc fgisSetHelper {w type widgets} {
330 array set CLASS {
331 legbox Canvas
332 shiftbuttons Button
333 zoombutton Button
334 unzoombuttons Button
335 statusline Label
336 }
337 upvar \#0 $w data
338 foreach i $widgets {
339     if ![string match {} $i] {
340         if {![winfo exist $i]} {
341           return -code error "Window $i doesn't exist"
342         } elseif {"[winfo class $i]"!="$CLASS($type)"} {
343           return -code error \ 
344           "Wrong window $i. Should be [string tolower $CLASS($type)] widget."
345         }
346     }
347 }    
348 # additional checks
349 switch -exact $type {
350     zoombutton { 
351        if [llength $widgets]>1 {
352           return -code error "-zoombutton allows only one widget"
353        }
354        if {[llength $widgets]&&![llength $data(limits)]} {
355            $widgets configure -state disabled
356        }
357     }
358     shiftbuttons { 
359        if [llength $widgets]!=4 {
360           return -code error "-shiftbuttons requires list of four buttons"
361        }
362        if [string length [join $widgets ""]] {
363            set dir {left down up right} 
364            set j 0
365            foreach i $widgets {
366               if [string compare {} $i] {
367                   $i configure -command [list $w shift [lindex $dir $j]]
368               } else {
369                   return -code error\ 
370                          "-shiftbuttons should all exist or all be empty"
371               }
372               incr j
373            }
374            set data(shiftbuttons) $widgets
375            fgisCheckShifts $w   
376        }
377     }   
378     unzoombuttons {}
379     default { 
380        if [llength $widgets]>1 {
381           return -code error "Only one widget allowed for -$type option"
382        }
383     } 
384 }
385 uplevel #0 set $w\($type) [list $widgets]
386 }
387 #                
388 # intercert widget cget command
389 #
390 #
391 ;proc fgisPlanchet_cget {w args} {
392     upvar \#0 $w data
393     if [llength $args]!=1 {
394      return -code error "Wrong # args. Should be $w cget option"
395     }
396     set arg [array names data [string trimleft $args -]] 
397     set num [llength $arg]
398     if $num==1 {
399       return $data($arg)
400     } elseif $num {
401       return -code error  "Amgiquous option \"$args\""
402     } elseif [catch {$data(cmd) cget $args} result] {
403       return -code error $result
404     } else {
405       return $result
406     }
407 }
408 #
409 #Set up new coordinates of ruler
410 #or simply redraws ruler, if shown
411 #
412 ;proc fgisPlanchet:ruler {w {coord {}}} {
413     upvar \#0 $w data
414     if [llength [$data(cmd) find withtag ruler]] {
415        fgisPlanchet_ruler off
416        if [string length $coord] {
417            set tmp $data(rulerpos)
418            set data(rulerpos) $coord
419            if [catch {fgisPlanchet_ruler on} err] {
420               set data(rulerpos) $tmp
421               fgisPlanchet_ruler on
422               return -code error $err
423            }
424        } else {
425          fgisPlanchet_ruler on
426        }
427     }   
428 }
429 #
430 # actually implements ruler command
431 #
432 #
433 ;proc fgisPlanchet_ruler {w {flag {}}} {
434 upvar \#0 $w data
435 switch -exact $flag {
436    {}  {
437         if [llength [$data(cmd) find withtag ruler]] {
438           return on
439         } else {
440           return off
441         }
442    }    
443    off {
444          $data(cmd) delete ruler
445        }
446    on  { #here we actually draw it
447          # parse coordinates
448          global fgis_font
449          foreach {x y} $data(rulerpos) break 
450          if [catch {fgisConvertCoords $data(cmd) x $x [winfo width $w]} x] {
451              return -code error $x
452          }      
453          if [catch {fgisConvertCoords $data(cmd) y $y [winfo height $w]} y] {
454              return -code error $y
455          }
456          if [llength $data(limits)]!=4 { 
457              return -code error "Coordinate system not defined for $w"
458          }
459          set origin_x [fgisPlanchet_mapx $w $x]
460          set origin_y [fgisPlanchet_mapy $w $y]
461          set meters [expr [fgisPlanchet_mapx $w 2c]-[fgisPlanchet_mapx $w 0c]]
462          for {set size 10;set step 2} {abs($size)<$meters } {
463                 set size [expr $size*$step]} {
464             set step [expr $step==2?5:2]
465          }
466         $data(cmd) create line $x $y [$w scrx [expr $origin_x+$size]] \
467               $y -width 3  -tags ruler
468         $data(cmd) create text $x [expr $y-5] -anchor s -text 0 -tags ruler \
469                -font $fgis_font(1)
470         if {$size>1000} {
471             set msg "[expr $size/1000]km"
472         } else {
473             set msg "${size}m"
474         }
475         $data(cmd) create text [$w scrx [expr $origin_x+$size]]\
476                 [expr $y-5] -anchor s -text $msg -tags ruler \
477                 -font $fgis_font(1)
478         for {set xx $origin_x} {$xx<=$size+$origin_x} {
479                       set xx [expr $xx+$size/$step]} { 
480            $data(cmd) create line [$w scrx $xx] $y [$w scrx $xx] [expr $y-4] \
481                   -tags ruler
482         }                 
483   } 
484 }
485 }
486 #
487 # Converts values given in any cordinate form into pixels
488 # if value is negative, corresponding window size is added
489 #
490
491 ;proc fgisConvertCoords {w cmd value limit} {
492    if [regexp -- {-(.*)} $value junk abs] {
493      set negate 1
494      set value $abs
495    } else { set negate 0 }
496    if [catch { expr [$w canvas$cmd $value]-[$w canvas$cmd 0]} value] {
497      return -code error $value
498    }  
499    if $negate {
500      return [expr $limit-$value]
501    } else {
502      return $value
503    } 
504 }   
505 #
506 # Sets limits of planchet coordinate system
507 # If limits were defined, pushes them into zoom stack and
508 # converts axis directions if neccessary
509 #
510 ;proc fgisPlanchet_limits {w args} {
511     upvar \#0 $w data
512     if [llength $args]==1 {
513       eval set args $args
514     } elseif ![llength $args] {
515        return $data(limits)
516     } 
517     if [string match $args* default] {
518         if {![llength $data(zoom)]} {
519            return -code error "No views stacked"
520         }
521         set data(limits) {}
522         set args [lindex $data(zoom) 0]
523         set data(zoom) {}
524     }
525     if [llength $args]!=4 {
526        return -code error "List of four floating point numbers expected"
527     }
528     foreach {x1 y1 x2 y2} $args break
529     set width [expr $x2-$x1]
530     set height [expr $y2-$y1]
531     if [llength $data(limits)] {
532         foreach b $data(unzoombuttons) {
533           $b config -state normal
534         }
535         if {$width*([lindex $data(limits) 2]-[lindex $data(limits) 0])<0} {
536            set tmp $x2; set x2 $x1; set x1 $tmp
537            set width [expr -$width]
538         }
539         if {$height*([lindex $data(limits) 3]-[lindex $data(limits) 1])<0} {
540             set tmp $y2;set y2 $y1;set y1 $tmp
541             set height [expr -$height]
542         }    
543     } else {
544       foreach b $data(unzoombuttons) {
545          $b config -state disabled
546       }
547       if [string length $data(zoombutton)] {
548          $data(zoombutton) config -state normal
549       }
550     } 
551     if {![llength $data(limits)]&&$data(resizable)} {
552     # Trying to adjust canvas size, preserving area 
553       set area [expr [winfo reqheight $w]*[winfo reqwidth $w]]
554       set ratio [expr abs($width/$height)]
555       set hei [expr sqrt($area/$ratio)]
556       set wid [expr $hei*$ratio]
557       $data(cmd) config -width $wid -height $hei
558     } else {
559     # Trying to expand coordinate limits 
560         if (abs($height/[winfo reqheight $w])<abs($width/[winfo reqwidth $w])) {
561          set newh [expr abs($width)*[winfo reqheight $w]/[winfo reqwidth $w]]
562          if ($height<0) {
563              set y2 [expr $y1-$newh]
564           } else {
565              set y2 [expr  $y1+$newh]
566           }
567         } else {
568           set neww [expr abs($height)*[winfo reqwidth $w]/[winfo reqheight $w]]
569           if ($width<0)  {
570              set x2 [expr $x1-$neww]
571           } else {
572              set x2 [expr $x1+$neww]
573           }
574         }
575            
576       if ![info exists data(this_is_not_zoom)] {
577           lappend  data(zoom) $data(limits)
578       }
579    }
580    set data(limits) [list $x1 $y1 $x2 $y2]
581    fgisManageZoomList $w
582    fgisCheckShifts $w
583    fgisPlanchet:Redraw $w
584 }
585 #
586 # checks all shift directions and enables/disables buttons, if exists
587 # strictly internal use, no error checking
588 #
589 ;proc fgisCheckShifts w {
590     upvar \#0 $w data
591     if [string length [join $data(shiftbuttons) ""]] {
592         foreach b $data(shiftbuttons) {
593             $b configure -state disabled
594         }
595         if [llength $data(zoom)] { 
596           foreach {X1 Y1 X2 Y2} [lindex $data(zoom) 0] break
597           foreach {x1 y1 x2 y2} $data(limits) break
598           foreach {left down up right} $data(shiftbuttons) break
599           fgisEnableShift $left $x1 $X1 $X2
600           fgisEnableShift $down $y1 $Y1 $Y2
601           fgisEnableShift $up   $y2 $Y2 $Y1
602           fgisEnableShift $right $x2 $X2 $X1
603         }
604   } 
605 }  
606 #
607 # fgisEnableShift - checks if shift in given direction is possible,
608 # and, if so, enables given button
609 #
610
611 ;proc fgisEnableShift {button view lim1 lim2} {
612     if {($view-$lim2)/($lim1-$lim2)<1} {
613        $button config -state normal
614     }
615 }    
616 #
617 # implements scale widget command
618 # without arguments returns current scale,
619 # with exactly one numeric argument sets scale to specified
620 # keeping center of window at same coordinates, otherwise calls canvas scale
621 #
622
623 ;proc fgisPlanchet_scale {w args} {
624    upvar \#0 $w data
625    if {[llength $args]<=1&&[llength $data(limits)]!=4} {
626       return -code error "Coorinate system for $w is not set"
627    }
628    if ![llength $args] {
629       return [format "%0.0f" [expr [$w mapx 1000m]-[$w mapx 0m]]]
630    } 
631    if [llength $args]==1 {
632        # compute coordinates of central point
633        set x [$w mapx [set halfwidth [expr [winfo reqwidth $w]/2]]]
634        set y [$w mapy [set halfheight [expr [winfo reqheight $w]/2]]]
635        # compute width and height in meters
636        set wm [expr $halfwidth/[$data(cmd) canvasx 1000m]-[$data(cmd) canvasx 0m]]
637        if [catch {expr $args*$wm} dx] {
638           return -code error $dx
639        }
640        set hm [expr {$halfheight/[$data(cmd) canvasy 1000m]-
641                     [$data(cmd) canvasy 0m]}]
642        set dy [expr $args*$hm]
643        foreach {x1 y1 x2 y2} $data(limits) break
644        if {$x1>$x2} {set dx [expr -$dx]}
645        set x1 [expr $x - $dx]
646        set x2 [expr $x + $dx]
647        if {$y1>$y2} {set dy [expr -$dy]}
648        set y1 [expr $y - $dy]
649        set y2 [expr $y + $dy]
650        fgisPlanchet_limits $w $x1 $y1 $x2 $y2
651    } elseif [catch {eval $data(cmd) scale $args} err] {
652        return -code error $err
653    }
654 }
655
656 #
657 # handles <Configure> events by expanding coordinate system appropriately
658 # and redrawing all layers
659 #
660 ;proc fgisPlanchet:resize {w} {
661 upvar \#0 $w data
662 set oldw [winfo reqwidth $w]
663 set oldh [winfo reqheight $w]
664 set nw [winfo width $w]
665 set nh [winfo height $w]
666 if {$oldw==$nw&&$oldh==$nh} return
667 $data(cmd) configure -width $nw -height $nh
668 if [llength $data(limits)]==4 {
669   foreach {x1 y1 x2 y2} $data(limits) break
670   set y2 [expr ($y2-$y1)/$oldh*$nh+$y1]
671   set x2 [expr ($x2-$x1)/$oldw*$nw+$x1]
672   set data(limits) [list $x1 $y1 $x2 $y2]
673   fgisCheckShifts $w
674   fgisPlanchet:Redraw $w
675 }  
676 }  
677
678 #
679 # implements shift command - shifts viewport shiftfactor share in given
680 # direction
681 #
682
683 ;proc fgisPlanchet_shift {w args} {
684     if [llength $args]!=1 {
685        return -code error "Wrong # args. should be $w shift direction"
686     }
687     upvar \#0 $w data
688     if [llength $data(limits)]!=4 {
689       return -code error "Coordinate system for $w not set"
690     }  
691     array set dir {
692     left {-1 0}
693     west {-1 0}
694     right {1 0}
695     east {1 0}
696     up {0 1}
697     north {0 1}
698     down {0 -1}
699     south {0 -1}
700     }
701     set d [array names dir [string tolower $args]*]
702     if [llength $d]>1 {
703       return -code error "Ambiquous direction \"$dir\"."
704     } elseif ![llength $d] {
705       return -code error \
706              "Invalid direction \"$dir\". Should be one of [array names dir]"
707     }
708     set  d $dir($d)
709     
710     foreach {x1 y1 x2 y2} $data(limits) break;
711     set dx [expr ($x2-$x1)*$data(shiftfactor)*[lindex $d 0]]
712     set dy [expr ($y2-$y1)*$data(shiftfactor)*[lindex $d 1]]
713     set data(limits) [list  [expr $x1+$dx] [expr $y1+$dy] [expr $x2+$dx]\
714              [expr $y2+$dy]]
715     fgisCheckShifts $w
716     fgisPlanchet:Redraw $w
717 }
718
719 #
720 # Pops up last zoom from stack
721 # does call _limits to ensure that possible window size changes are haldled
722 #
723
724 ;proc fgisPlanchet_unzoom w {
725     upvar \#0 $w data
726     if ![set len [llength $data(zoom)]] {
727       return -code error "No views stacked"
728     }
729     set data(this_is_not_zoom) {}
730     set newlim [lindex $data(zoom) [incr len -1]]
731     set data(zoom) [lreplace $data(zoom) $len end]
732     fgisPlanchet_limits $w $newlim
733     unset data(this_is_not_zoom)
734 }
735
736 #
737 # Checks it zoom stack contain some views with larger scale than current
738 # and discards them, becouse unzoom should never enlarge scale.
739 # (it was too annoying in Serge Mikhailov's eppedit
740 #
741 # Here can also be shifting of old views to make them contain new one,
742 # but I'm not sure that here is a good way to do so
743 #
744
745 ;proc fgisManageZoomList w {
746     upvar \#0 $w data 
747     set zoom {}
748     set width [expr abs([lindex $data(limits) 2]-[lindex $data(limits) 0])]
749     foreach view $data(zoom) {
750         if {abs([lindex $view 2]-[lindex $view 0])>$width} {
751             lappend zoom $view
752         }
753     }
754     if [llength $zoom] {
755        set data(zoom) $zoom
756     } elseif [llength $data(zoom)] {
757        # always preserve default limits
758        set data(zoom) [list [lindex $data(zoom) 0]]
759     }
760     # update scale variable, if exist
761     if [string length $data(scalevar)] {
762         uplevel \#0 set $data(scalevar) "1:[fgisPlanchet_scale $w]"
763     }
764     # redraw ruler, if it is already visible
765
766 }
767
768 #
769 # Implements zoom widget command.
770 # with no options start interactive zooming process
771 # with two coords starts interactive zooming with specified point (in
772 # canvas coord) as one of corner. With four coords - just does it.
773 # with cancel flag - cancels zoom in progress
774 #
775 ;proc fgisPlanchet_zoom {w args} {
776    upvar \#0 $w data
777    switch -exact [llength $args] {
778    0 { 
779        fgisPlanchet_setstatus $w \
780                 "Pick first corner. ESC or right button cancels"
781         bind Zoom <Button-1> "fgisPlanchet_zoom %W %x %y;break"
782         bind Zoom <Any-Motion> "break" 
783         bindtags $w [linsert [bindtags $w] 0 Zoom] 
784    }
785    1 { if ![string match $args* cancel] {
786          return -code error "Wrong # args. Should be $w zoom ?x y ?x y?? or\
787             $w zoom cancel"
788        }
789        if {![string match "Zoom*" [lindex [bindtags $w] 0]]} {
790            return -code error "No zoom in progress"
791        }
792        bindtags $w [lrange [bindtags $w] 1 end]
793        $data(cmd) delete zoomer
794        fgisPlanchet_setstatus {}
795    }
796    2 { if {[lindex [bindtags $w] 0]!="Zoom"} {
797            bindtags $w [linsert [bindtags $w] 0 Zoom]]
798        }
799        fgisPlanchet_setstatus $w\
800                "Pick second corner. ESC or right button cancels"
801        set x [lindex $args 0]
802        set y [lindex $args 1]
803        $data(cmd) create rectangle $x $y $x $y -tag zoomer
804        bind Zoom <Button-1> "fgisPlanchet_zoom %W $x $y %x %y;break"
805        bind Zoom <Any-Motion> "%W coord zoomer $x $y %x %y; break"
806    }
807    4 { foreach {x1 y1 x2 y2} $args break
808        if {[lindex [bindtags $w] 0]=="Zoom"} {
809           bindtags $w [lrange [bindtags $w] 1 end]
810        }
811        fgisPlanchet_limits $w [$w mapx $x1] [$w mapy $y1] [$w mapx $x2]\
812             [$w mapy $y2]
813        $data(cmd) delete zoomer
814      } 
815    default {
816      return -code error  "Wrong # args. Should be $w zoom ?x y ?x y?? or\
817             $w zoom cancel"
818    }
819 }
820 }
821
822 #
823 # clear - deletes all layers and resets coordinate system. 
824 # leaves projection untouched
825 #
826
827 ;proc fgisPlanchet_clear w {
828    upvar \#0 $w data
829    set data(lookable) {}
830    foreach layer [concat $data(overlays) $data(base)] {
831       $layer hide $w
832    } 
833    $data(cmd) delete all
834    set data(limits) {}
835    set data(zoom) {}
836    set data(overlays) {}
837    set data(base) {}
838    if {[string length $data(legbox)]} {$data(legbox) delete all}
839    foreach b [concat $data(unzoombuttons) [list $data(zoombutton)] \
840           $data(shiftbuttons)] {
841      if {[string length $b]&&[winfo exists $b]} {
842          $b configure -state disabled
843      }
844    }   
845 }
846
847 #
848 # layers - returns list of all layers
849
850 #
851
852 ;proc fgisPlanchet_layers {w args} {
853     upvar \#0 $w data
854     if [llength $args]>1 {
855         return -code error "Wrong # of args. Should be $w layers ?pattern?"
856     }
857     if ![llength $args] { set args "*"}
858     set result {} 
859     upvar #0 $w data
860     foreach l [concat $data(base) $data(overlays)] {
861       if {[string match $args $l]&&[lsearch -exact $result $l]==-1} {
862          lappend result $l
863       }
864     }
865     return $result
866 }
867
868 #
869 # hide $layer - clears given layer
870 #
871 #
872 ;proc fgisPlanchet_hide {w args} {
873    upvar \#0 $w data
874    foreach l $args {
875       set list [fgisPlanchet_layers $w $l]
876       if ![llength $list] {
877          return -code error "No such layer \"$l\" in $w"
878       }
879       foreach ll $list {
880          $ll hide $w
881          $data(cmd) delete $ll
882          if {"$ll"=="$data(base)"} {
883            if {[string length $data(legbox)]} {
884                $data(legbox) delete all
885            }
886            set data(base) {}
887          }
888          if {[set index [lsearch -exact $data(overlays) $ll]]!=-1} {
889             set data(overlays) [lreplace $data(overlays) $index $index]
890          }   
891       }
892    }
893   
894 }
895
896 #
897 # show $layer ?-base|-overlay?
898 # displays layer
899 #
900 ;proc fgisPlanchet_show {w args} {
901    upvar \#0 $w data
902    if ![llength $args]&&[llength $args]>2 {
903       return -code error "Wrong # args. Should be $w show layer ?mode?"
904    }
905    set layer [lindex $args 0] 
906    if [llength $args]==1 {
907       if {![llength $data(limits)]&&[$layer info opaque]} {
908         set mode -base
909       } else {
910         set mode -overlay
911       }
912    } else {
913      set mode [lindex $args 1]
914      if [string match $mode* -base] {
915         set mode -base
916         if ![$layer info opaque] {
917            return -code error "Opaque mode is not supporded by $layer"
918         } 
919      } elseif [string match $mode* -overlay] {
920         set mode -overlay
921         if [lsearch -exact $data(overlays) $layer]!=-1 {
922            return -code error "Layer \"$layer\" already visible in $w"
923         }
924      } else {
925         return -code error \
926             "Invalid option \"$mode\". Should be -base or -overlay"
927      }
928    }
929    if ![llength $data(limits)] {
930      if [$layer info limits] {
931        # am I wrong?
932        eval fgisPlanchet_limits $w [$layer limits]
933      } else {
934        return -code error\
935             "Cannot show $layer without defined coordinate system" 
936      }
937    } else {
938      foreach {x1 y1 x2 y2} [$layer limits] break
939      foreach {X1 Y1 X2 Y2} $data(limits) break
940      if {($x2-$x1)*($X2-$X1)<0||($Y2-$Y1)*($y2-$y1)<0} {
941         return -code error "Layer $layer is not compatible with $w"
942      }
943    }
944    $layer show $w $mode
945    if {$mode=="-base"} {
946       if [llength $data(base)] {
947          $data(base)  hide $w
948          $data(cmd) delete $data(base)
949       }
950       set data(base) $layer
951       $data(cmd) lower $layer
952       if {[string length $data(legbox)]&&[winfo exists $data(legbox)]} {
953         drawlegend 0 0 $data(legbox) $layer -base -columns 1 \
954               -width [$data legbox cget -width]
955       }
956    } else {
957      lappend data(overlays) $layer
958    } 
959    fgisPlanchet_setstatus $w "REDRAW: Wait please..."
960    update
961    $layer redraw $w
962    fgisPlanchet_setstatus $w {}
963 }
964
965 #
966 #
967 # fgisPlanchet:Redraw - redraws all layers. Very expensive thing.
968 # Should be called only if view coords are changed
969 #
970 ;proc fgisPlanchet:Redraw {w} {
971     upvar \#0 $w data
972     fgisPlanchet_setstatus $w "REDRAW: Wait please..."
973     update
974     foreach layer [concat $data(base) $data(overlays)] {
975         $layer redraw $w
976     }
977     fgisPlanchet_setstatus $w {}
978     if {[fgisPlanchet_ruler $w]=="on"} {
979          fgisPlanchet_ruler $w off
980          fgisPlanchet_ruler $w on
981     }    
982     update
983 }  
984 ;proc fgisPlanchet_print {w args} {
985 upvar \#0 $w data
986 global fgis
987 array set opt [list\
988 file "|"\
989 printer $fgis(printer)\
990 colormode $fgis(print_colormode)\
991 fontmap fgis_fontmap] 
992
993 getopt opt $args
994 if [uplevel array exist $opt(fontmap)] {
995     upvar $opt(fontmap) fontmap
996 } elseif [uplevel #0 array exist $opt(fontmap)] {
997     upvar $opt(fontmap) fontmap
998 } else {
999    return -code error "Array \"$opt(fontmap)\" doesn't exist"
1000 }
1001 if {$data(orient)=="landscape"} {set rotate y} else {set rotate n}
1002 if [catch {if {$opt(file)=="|"} {
1003    exec $fgis(printcmd) -P$opt(printer) << [ $data(cmd) postscript\
1004       -rotate $rotate -colormode $opt(colormode) -fontmap fontmap
1005 } else {
1006   $data(cmd) postscript -rotate $rotate -colormode $opt(colormode)\
1007       -fontmap fontmap -file $opt(file)
1008 } } err ] {
1009   return -code error $err
1010 }
1011 }