3 # definition of planchet widget.
5 # This file is part of fGIS tcl library
6 # Copyright (c) by SoftWeyr, 1997
17 shiftbuttons {{} {} {} {}}
25 #this options are got from application defaults
26 array set Planchet [list\
27 coordformat $fgis(coordformat)\
29 shiftfactor $fgis(shift_factor)\
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
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"
59 # create planchet widget
62 proc planchet {w args} {
66 array set data [array get Planchet]
68 if [catch {getopt data $args} err] {
70 return -code error $err
72 set restargs $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] {
78 return -code error $err
81 #correct value of "resizable" options
82 if [checkbooleanopt data(resizable) err] {
83 return -code error $err
86 if [catch {eval canvas [list $w] $restargs -bd 0\
87 -highlightthickness 0} err] {
89 return -code error $err
91 bindtags $w [list $w Planchet [winfo parent $w] all]
92 #create widget command
95 ;proc $w args "eval fgisPlanchet:eval [list $w] \$args"
98 set data(lookToplevel) [toplevel $w.look -class LookToplevel\
100 set data(lookLabel) [label $w.look.label -wraplength $data(lookwidth)\
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
120 # -evaluates planchet widget command
122 ;proc fgisPlanchet:eval {w option args} {
124 if [string match {} [set arg [info command fgisPlanchet_$option]]] {
125 set arg [info command fgiPlanchet_$option*]
127 switch -exact [llength $arg] {
128 0 { if [catch {uplevel [list $data(cmd) $option] $args} err] {
129 return -code error $err
134 1 {return [uplevel $arg [list $w] $args] }
136 return -code error "ambiquous option \"$option\""
142 # fgisPlanchet:destroy
146 ;proc fgisPlanchet:destroy w {
148 foreach layer [linsert $data(overlays) end $data(base)] {
149 if [string length $layer] {$layer hide $w}
152 #catch {rename $data(cmd) $w}
157 # releases grab and hides look window
159 ;proc fgisPlanchet:hidelook {w} {
160 catch {grab release $w}
164 # Given point in canvas coordinates, displays window with content
167 ;proc fgisPlanchet:look {w x y} {
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"
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)]]
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)]]
183 wm geometry $data(lookToplevel) +$rootx+$rooty
184 wm deiconify $data(lookToplevel)
185 raise $data(lookToplevel)
186 grab $data(lookToplevel)
189 # User visible implementation of look. Can be invoked as look planchet
190 # subcommand. Gets two map-coordinates and returns list of active layers
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
199 # Layers that return an empty string are ignored
201 ;proc fgisPlanchet_look {w x {y {}} {flag -list}} {
203 switch -exact -- $x {
205 if ![string length $y] {
206 return -code error "Wrong # args. Should be $w look add layer"
208 if ![layer exists $y] {
209 return -code error "Layer \"$y\" doesn't exist"
211 if ![$y info lookable] {
212 return -code error "Layer \"$y\" is not lookable"
214 if [lsearch -exact $data(lookable) $y]!=-1 {
215 return -code error "Layer \"$y\" is already in look list of $w"
217 lappend data(lookable) $y
220 if ![string length $y] {
222 "Wrong # args. Should be $w look remove pattern"
225 set data(lookable) {}
227 if [lsearch -glob $data(lookable) $y]==-1 {
228 return -code error "No layers match pattern \"$y\""
230 while {[set index [lsearch -glob $data(lookable) $y]]!=-1} {
231 set data(lookable) [lreplace $data(lookable) $index $index]
237 if [string match {} $y] {set y *}
238 foreach l $data(lookable) {
239 if [string match $y $l] {
247 foreach layer $data(lookable) {
248 lappend result [$layer value $x $y $flag]
255 # Displays mouse coordinates in window.
256 # Recalculates pixels to meters and calls $w setstatus
257 # If no coordinate defined, displays "No coords"
260 ;proc fgisPlanchet:setstatus {w x y} {
262 if ![llength $data(limits)] {
263 fgisPlanchet_setstatus $w "No coordinates defined"
265 fgisPlanchet_setstatus $w [fgisPlanchet_mapx $w $x] [fgisPlanchet_mapy $w $y]
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 {}}} {
276 if ![string length $data(statusline)] {
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]
284 $data(statusline) configure -text [$data(projection) format $x $y]
289 # intercepts widget configure command
292 ;proc fgisPlanchet_configure {w args} {
295 return [eval $data(cmd) configure]
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)"\
312 highlightthickness {#}\
313 default "lappend restargs"\
316 if [catch {handleopt opt $args} res] {
317 return -code error $res
319 if [llength $restargs] {
320 if [catch {eval $data(cmd) configure $restargs}] {
321 return -code error $res
326 # Installs link to helper widget.
327 # Strictly internal use
329 ;proc fgisSetHelper {w type 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)"} {
344 "Wrong window $i. Should be [string tolower $CLASS($type)] widget."
349 switch -exact $type {
351 if [llength $widgets]>1 {
352 return -code error "-zoombutton allows only one widget"
354 if {[llength $widgets]&&![llength $data(limits)]} {
355 $widgets configure -state disabled
359 if [llength $widgets]!=4 {
360 return -code error "-shiftbuttons requires list of four buttons"
362 if [string length [join $widgets ""]] {
363 set dir {left down up right}
366 if [string compare {} $i] {
367 $i configure -command [list $w shift [lindex $dir $j]]
370 "-shiftbuttons should all exist or all be empty"
374 set data(shiftbuttons) $widgets
380 if [llength $widgets]>1 {
381 return -code error "Only one widget allowed for -$type option"
385 uplevel #0 set $w\($type) [list $widgets]
388 # intercert widget cget command
391 ;proc fgisPlanchet_cget {w args} {
393 if [llength $args]!=1 {
394 return -code error "Wrong # args. Should be $w cget option"
396 set arg [array names data [string trimleft $args -]]
397 set num [llength $arg]
401 return -code error "Amgiquous option \"$args\""
402 } elseif [catch {$data(cmd) cget $args} result] {
403 return -code error $result
409 #Set up new coordinates of ruler
410 #or simply redraws ruler, if shown
412 ;proc fgisPlanchet:ruler {w {coord {}}} {
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
425 fgisPlanchet_ruler on
430 # actually implements ruler command
433 ;proc fgisPlanchet_ruler {w {flag {}}} {
435 switch -exact $flag {
437 if [llength [$data(cmd) find withtag ruler]] {
444 $data(cmd) delete ruler
446 on { #here we actually draw it
449 foreach {x y} $data(rulerpos) break
450 if [catch {fgisConvertCoords $data(cmd) x $x [winfo width $w]} x] {
451 return -code error $x
453 if [catch {fgisConvertCoords $data(cmd) y $y [winfo height $w]} y] {
454 return -code error $y
456 if [llength $data(limits)]!=4 {
457 return -code error "Coordinate system not defined for $w"
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]
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 \
471 set msg "[expr $size/1000]km"
475 $data(cmd) create text [$w scrx [expr $origin_x+$size]]\
476 [expr $y-5] -anchor s -text $msg -tags ruler \
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] \
487 # Converts values given in any cordinate form into pixels
488 # if value is negative, corresponding window size is added
491 ;proc fgisConvertCoords {w cmd value limit} {
492 if [regexp -- {-(.*)} $value junk abs] {
495 } else { set negate 0 }
496 if [catch { expr [$w canvas$cmd $value]-[$w canvas$cmd 0]} value] {
497 return -code error $value
500 return [expr $limit-$value]
506 # Sets limits of planchet coordinate system
507 # If limits were defined, pushes them into zoom stack and
508 # converts axis directions if neccessary
510 ;proc fgisPlanchet_limits {w args} {
512 if [llength $args]==1 {
514 } elseif ![llength $args] {
517 if [string match $args* default] {
518 if {![llength $data(zoom)]} {
519 return -code error "No views stacked"
522 set args [lindex $data(zoom) 0]
525 if [llength $args]!=4 {
526 return -code error "List of four floating point numbers expected"
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
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]
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]
544 foreach b $data(unzoombuttons) {
545 $b config -state disabled
547 if [string length $data(zoombutton)] {
548 $data(zoombutton) config -state normal
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
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]]
563 set y2 [expr $y1-$newh]
565 set y2 [expr $y1+$newh]
568 set neww [expr abs($height)*[winfo reqwidth $w]/[winfo reqheight $w]]
570 set x2 [expr $x1-$neww]
572 set x2 [expr $x1+$neww]
576 if ![info exists data(this_is_not_zoom)] {
577 lappend data(zoom) $data(limits)
580 set data(limits) [list $x1 $y1 $x2 $y2]
581 fgisManageZoomList $w
583 fgisPlanchet:Redraw $w
586 # checks all shift directions and enables/disables buttons, if exists
587 # strictly internal use, no error checking
589 ;proc fgisCheckShifts w {
591 if [string length [join $data(shiftbuttons) ""]] {
592 foreach b $data(shiftbuttons) {
593 $b configure -state disabled
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
607 # fgisEnableShift - checks if shift in given direction is possible,
608 # and, if so, enables given button
611 ;proc fgisEnableShift {button view lim1 lim2} {
612 if {($view-$lim2)/($lim1-$lim2)<1} {
613 $button config -state normal
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
623 ;proc fgisPlanchet_scale {w args} {
625 if {[llength $args]<=1&&[llength $data(limits)]!=4} {
626 return -code error "Coorinate system for $w is not set"
628 if ![llength $args] {
629 return [format "%0.0f" [expr [$w mapx 1000m]-[$w mapx 0m]]]
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
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
657 # handles <Configure> events by expanding coordinate system appropriately
658 # and redrawing all layers
660 ;proc fgisPlanchet:resize {w} {
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]
674 fgisPlanchet:Redraw $w
679 # implements shift command - shifts viewport shiftfactor share in given
683 ;proc fgisPlanchet_shift {w args} {
684 if [llength $args]!=1 {
685 return -code error "Wrong # args. should be $w shift direction"
688 if [llength $data(limits)]!=4 {
689 return -code error "Coordinate system for $w not set"
701 set d [array names dir [string tolower $args]*]
703 return -code error "Ambiquous direction \"$dir\"."
704 } elseif ![llength $d] {
706 "Invalid direction \"$dir\". Should be one of [array names dir]"
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]\
716 fgisPlanchet:Redraw $w
720 # Pops up last zoom from stack
721 # does call _limits to ensure that possible window size changes are haldled
724 ;proc fgisPlanchet_unzoom w {
726 if ![set len [llength $data(zoom)]] {
727 return -code error "No views stacked"
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)
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
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
745 ;proc fgisManageZoomList w {
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} {
756 } elseif [llength $data(zoom)] {
757 # always preserve default limits
758 set data(zoom) [list [lindex $data(zoom) 0]]
760 # update scale variable, if exist
761 if [string length $data(scalevar)] {
762 uplevel \#0 set $data(scalevar) "1:[fgisPlanchet_scale $w]"
764 # redraw ruler, if it is already visible
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
775 ;proc fgisPlanchet_zoom {w args} {
777 switch -exact [llength $args] {
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]
785 1 { if ![string match $args* cancel] {
786 return -code error "Wrong # args. Should be $w zoom ?x y ?x y?? or\
789 if {![string match "Zoom*" [lindex [bindtags $w] 0]]} {
790 return -code error "No zoom in progress"
792 bindtags $w [lrange [bindtags $w] 1 end]
793 $data(cmd) delete zoomer
794 fgisPlanchet_setstatus {}
796 2 { if {[lindex [bindtags $w] 0]!="Zoom"} {
797 bindtags $w [linsert [bindtags $w] 0 Zoom]]
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"
807 4 { foreach {x1 y1 x2 y2} $args break
808 if {[lindex [bindtags $w] 0]=="Zoom"} {
809 bindtags $w [lrange [bindtags $w] 1 end]
811 fgisPlanchet_limits $w [$w mapx $x1] [$w mapy $y1] [$w mapx $x2]\
813 $data(cmd) delete zoomer
816 return -code error "Wrong # args. Should be $w zoom ?x y ?x y?? or\
823 # clear - deletes all layers and resets coordinate system.
824 # leaves projection untouched
827 ;proc fgisPlanchet_clear w {
829 set data(lookable) {}
830 foreach layer [concat $data(overlays) $data(base)] {
833 $data(cmd) delete all
836 set data(overlays) {}
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
848 # layers - returns list of all layers
852 ;proc fgisPlanchet_layers {w args} {
854 if [llength $args]>1 {
855 return -code error "Wrong # of args. Should be $w layers ?pattern?"
857 if ![llength $args] { set args "*"}
860 foreach l [concat $data(base) $data(overlays)] {
861 if {[string match $args $l]&&[lsearch -exact $result $l]==-1} {
869 # hide $layer - clears given layer
872 ;proc fgisPlanchet_hide {w args} {
875 set list [fgisPlanchet_layers $w $l]
876 if ![llength $list] {
877 return -code error "No such layer \"$l\" in $w"
881 $data(cmd) delete $ll
882 if {"$ll"=="$data(base)"} {
883 if {[string length $data(legbox)]} {
884 $data(legbox) delete all
888 if {[set index [lsearch -exact $data(overlays) $ll]]!=-1} {
889 set data(overlays) [lreplace $data(overlays) $index $index]
897 # show $layer ?-base|-overlay?
900 ;proc fgisPlanchet_show {w args} {
902 if ![llength $args]&&[llength $args]>2 {
903 return -code error "Wrong # args. Should be $w show layer ?mode?"
905 set layer [lindex $args 0]
906 if [llength $args]==1 {
907 if {![llength $data(limits)]&&[$layer info opaque]} {
913 set mode [lindex $args 1]
914 if [string match $mode* -base] {
916 if ![$layer info opaque] {
917 return -code error "Opaque mode is not supporded by $layer"
919 } elseif [string match $mode* -overlay] {
921 if [lsearch -exact $data(overlays) $layer]!=-1 {
922 return -code error "Layer \"$layer\" already visible in $w"
926 "Invalid option \"$mode\". Should be -base or -overlay"
929 if ![llength $data(limits)] {
930 if [$layer info limits] {
932 eval fgisPlanchet_limits $w [$layer limits]
935 "Cannot show $layer without defined coordinate system"
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"
945 if {$mode=="-base"} {
946 if [llength $data(base)] {
948 $data(cmd) delete $data(base)
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]
957 lappend data(overlays) $layer
959 fgisPlanchet_setstatus $w "REDRAW: Wait please..."
962 fgisPlanchet_setstatus $w {}
967 # fgisPlanchet:Redraw - redraws all layers. Very expensive thing.
968 # Should be called only if view coords are changed
970 ;proc fgisPlanchet:Redraw {w} {
972 fgisPlanchet_setstatus $w "REDRAW: Wait please..."
974 foreach layer [concat $data(base) $data(overlays)] {
977 fgisPlanchet_setstatus $w {}
978 if {[fgisPlanchet_ruler $w]=="on"} {
979 fgisPlanchet_ruler $w off
980 fgisPlanchet_ruler $w on
984 ;proc fgisPlanchet_print {w args} {
989 printer $fgis(printer)\
990 colormode $fgis(print_colormode)\
991 fontmap fgis_fontmap]
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
999 return -code error "Array \"$opt(fontmap)\" doesn't exist"
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
1006 $data(cmd) postscript -rotate $rotate -colormode $opt(colormode)\
1007 -fontmap fontmap -file $opt(file)
1009 return -code error $err