# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: canvhand.tcl,v 2.47 2005/02/18 23:14:21 jfontain Exp $


class canvasWindowManager {

    class handles {       ;# embed widget in a frame with handles for resizing and moving inside a canvas acting as a window manager

        set (defaultTitleBackground) gray

        proc handles {this parentPath manager args} composite {[new frame $parentPath] $args} {
            if {![string equal [winfo class $parentPath] Canvas]} {
                error {parent must be the manager canvas}
            }
            set ($this,item) [$parentPath create window 0 0 -window $widget::($this,path) -anchor nw]
            set ($this,manager) $manager
            set ($this,canvas) $parentPath
            set ($this,filled) 0
            set ($this,drag) [new dragSite -path $widget::($this,path) -grab 0]
            composite::complete $this
            updateDragProviding $this
        }

        proc ~handles {this} {
            delete $($this,drag)
            catch {delete $($this,labelDrag)}
            $($this,canvas) delete $($this,item) outline                                 ;# delete canvas items (eventually outline)
            catch {delete $($this,minimize)}                                                        ;# minimize button may not exist
        }

        proc options {this} {                                                            ;# force default coordinates initialization
            return [list\
                [list -background $widget::option(frame,background) $widget::option(frame,background)]\
                [list -borderwidth 3]\
                [list -dragobject {} {}]\
                [list -handlesize 7 7]\
                [list -path {} {}]\
                [list -relief ridge]\
                [list -setheight {} {}]\
                [list -setwidth {} {}]\
                [list -setx {}]\
                [list -sety {}]\
                [list -static 0]\
                [list -title {} {}]\
                [list -titlebackground $(defaultTitleBackground) $(defaultTitleBackground)]\
            ]
        }

        proc set-handlesize {this value} {
            resize $this [winfo width $widget::($this,path)] [winfo height $widget::($this,path)]             ;# recalculate handles
        }

        proc set-path {this value} {  ;### mandatory construction time option: eventually enforce or make a constructor argument ###
            if {$($this,filled)} {
                error {cannot manage more than 1 widget}
            }
            if {![winfo exists $value]} {
                error "invalid widget: \"$value\""
            }
            pack $value -in $widget::($this,path) -side bottom -fill both -expand 1                       ;# expand as manager frame
            stack $this raise                                            ;# newly managed widgets always appear on top of the others
            set ($this,filled) 1
        }

        proc set-background {this value} {
            $widget::($this,path) configure -background $value
        }

        proc set-borderwidth {this value} {
            if {$value < 3} {
                set value 3                                                        ;# so that borders are large enough to be grabbed
            }
            $widget::($this,path) configure -borderwidth $value
        }

        proc set-relief {this value} {
            $widget::($this,path) configure -relief $value
        }

        proc set-setheight {this value} {
            $($this,canvas) itemconfigure $($this,item) -height $value
        }
        proc set-setwidth {this value} {
            $($this,canvas) itemconfigure $($this,item) -width $value
        }

        proc set-setx {this value} {                                                               ;# only valid for initial setting
            if {[string length $value] == 0} {                       ;# place widget on the left side of the visible area by default
                set value [lindex [$global::canvas cget -scrollregion] 0]
            }
            $($this,canvas) coords $($this,item) $value [lindex [$($this,canvas) coords $($this,item)] end]
        }

        proc set-sety {this value} {                                                               ;# only valid for initial setting
            if {[string length $value] == 0} {                        ;# place widget on the top side of the visible area by default
                set value [lindex [$global::canvas cget -scrollregion] 1]
            }
            $($this,canvas) coords $($this,item) [lindex [$($this,canvas) coords $($this,item)] 0] $value
        }

        proc set-static {this value} {
            updateBindings $this $value
            updateMinimize $this
        }

        proc set-title {this value} {
            if {![info exists ($this,title)]} {
                set title [frame $widget::($this,path).title]
                pack $title -side top -fill x -before $composite::($this,-path)
                set label [label $title.label\
                    -pady 0 -font $font::(smallNormal) -background $composite::($this,-titlebackground) -anchor w\
                ]
                pack $label -side left -fill both -expand 1
                set minimize [new arrowButton $title\
                    -highlightthickness 0 -command "canvasWindowManager::minimize $($this,manager) $this [list $value]"\
                ]
                set size [expr {[winfo reqheight $label] - (2 * [composite::cget $minimize -borderwidth])}]
                composite::configure $minimize -width $size -height $size
                composite::configure $minimize base -cursor left_ptr
                if {[string length $composite::($this,-path)] > 0} {
                    # always place before the displayed widget so that when the user shrinks the window too much,
                    # title area always remains visible
                    pack $title -before $composite::($this,-path)
                }
                set ($this,labelDrag) [new dragSite -path $label -grab 0]       ;# handles can be moved thus dragged from title area
                set ($this,title) $title
                set ($this,label) $label
                set ($this,minimize) $minimize
                updateDragProviding $this
            }
            $($this,label) configure -text $value
            updateBindings $this $composite::($this,-static)
            updateMinimize $this
        }

        proc set-titlebackground {this value} {
            if {![info exists ($this,label)]} return
            if {[string length $value] == 0} {set value $(defaultTitleBackground)}
            $($this,label) configure -background $value
        }

        proc set-dragobject {this value} {
            updateDragProviding $this
        }

        proc updateDragProviding {this} {
            dragSite::provide $($this,drag) HANDLES "dragEcho $this"
            set title [info exists ($this,title)]
            if {$title} {
                dragSite::provide $($this,labelDrag) HANDLES "dragEcho $this"
            }
            set object $composite::($this,-dragobject)
            if {[string length $object] == 0} {                                                                  ;# disable dragging
                dragSite::provide $($this,drag) OBJECTS {}
                if {$title} {dragSite::provide $($this,labelDrag) OBJECTS {}}
            } else {
                dragSite::provide $($this,drag) OBJECTS "dragEcho $object"
                if {$title} {dragSite::provide $($this,labelDrag) OBJECTS "dragEcho $object"}
            }
        }

        proc updateBindings {this static} {
            set path $widget::($this,path)
            if {$static} {
                bind $path <Configure> {}
                bind $path <Motion> {}
                bind $path <Enter> {}
                bind $path <Button1-Motion> {}
                bind $path <ButtonPress-1> {}
                bind $path <ButtonRelease-1> "canvasWindowManager::handles::toggleVisibility $this"
                $path configure -cursor left_ptr
            } else {
                bind $path <Configure> "canvasWindowManager::handles::resize $this %w %h"                    ;# monitor size changes
                bind $path <Motion> "canvasWindowManager::handles::setCursor $this %x %y"
                # when just entering window, no motion event is yet generated
                bind $path <Enter> "canvasWindowManager::handles::setCursor $this %x %y"
                bind $path <Button1-Motion> "canvasWindowManager::handles::buttonMotion $this %x %y"
                bind $path <Control-ButtonPress-1> "canvasWindowManager::handles::buttonPress $this %x %y 1"
                bind $path <ButtonPress-1> "canvasWindowManager::handles::buttonPress $this %x %y"
                bind $path <ButtonPress-1> "+ dragSite::button1Pressed $($this,drag)"               ;# manually start drag mechanism
                bind $path <ButtonRelease-1> "canvasWindowManager::handles::buttonRelease $this"
            }
            bind $path <ButtonRelease-2> "canvasWindowManager::handles::toggleVisibility $this"
            if {[info exists ($this,label)]} {                                                                         ;# title area
                set path $($this,label)
                if {$static} {
                    $path configure -cursor left_ptr
                    bind $path <Button1-Motion> {}
                    bind $path <ButtonPress-1> {}
                    bind $path <ButtonRelease-1> "canvasWindowManager::handles::toggleVisibility $this"
                } else {                                                                      ;# allow moving window from title area
                    $path configure -cursor fleur
                    bind $path <Button1-Motion> "canvasWindowManager::handles::buttonMotion $this %x %y"
                    bind $path <Control-ButtonPress-1> "
                        set canvasWindowManager::handles::($this,direction) {}           ;# moving, not resizing, so reset direction
                        canvasWindowManager::handles::buttonPress $this %x %y 1
                    "
                    bind $path <ButtonPress-1> "
                        set canvasWindowManager::handles::($this,direction) {}           ;# moving, not resizing, so reset direction
                        canvasWindowManager::handles::buttonPress $this %x %y
                    "
                    bind $path <ButtonPress-1> "+ dragSite::button1Pressed $($this,labelDrag)"      ;# manually start drag mechanism
                    bind $path <ButtonRelease-1> "canvasWindowManager::handles::buttonRelease $this"
                }
                bind $path <ButtonRelease-2> "canvasWindowManager::handles::toggleVisibility $this"
            }
        }

        proc buttonMotion {this x y} {
            set (motion) {}
            updateOutline $this $x $y
        }

        proc buttonPress {this x y {control 0}} {
            set canvas $($this,canvas)
            set (xLast) $x; set (yLast) $y
            set (control) $control
            lifoLabel::push $global::messenger {}    ;# in case no other string is pushed before button release event pops messenger
            createOutline $this
            foreach {x y} [canvasWindowManager::coordinates $canvas $($this,item)] {}
            set (xOutline) $x; set (yOutline) $y
            foreach {(left) top right bottom} [$canvas cget -scrollregion] {}                                 ;# current page limits
            # insert canvas bounds first in list for highest priority
            set (rectangles) [list\
                [list $(left) $top [winfo width $canvas] [winfo height $canvas]]\
                [list $(left) $top [expr {$right - $(left)}] [expr {$bottom - $top}]]\
            ]
            eval lappend (rectangles) [canvasWindowManager::rectangles $($this,manager) $this]
            set width [winfo width $widget::($this,path)]; set height [winfo height $widget::($this,path)]
            set offset [xOffset $canvas $x $y $width $height]
            if {[string length $offset] > 0} {                                                                  ;# initially snapped
                set (xOffset) $offset
                set (xMagnet) [expr {$x + $offset}]                                       ;# note: offset should be always be 0 here
            }
            set offset [yOffset $canvas $x $y $width $height]
            if {[string length $offset] > 0} {                                                                  ;# initially snapped
                set (yOffset) $offset
                set (yMagnet) [expr {$y + $offset}]                                       ;# note: offset should be always be 0 here
            }
        }

        proc toggleVisibility {this} {
            if {[canvasWindowManager::raisedOnTop $($this,manager) $composite::($this,-path)]} {
                stack $this lower                               ;# else place below other windows so they get a chance to be visible
            } else {
                stack $this raise                                              ;# place on top if partially hidden by another window
            }
        }

        proc buttonRelease {this} {
            lifoLabel::pop $global::messenger
            if {[info exists (motion)]} {                                                              ;# moving or resizing occured
                updateGeometry $this
                stack $this raise                                                   ;# always place widget on top after acting on it
                unset (motion)
            } else {                                                                                ;# no moving or resizing occured
                toggleVisibility $this
            }
            destroyOutline $this
            catch {unset (xLast) (yLast)}                            ;# should never fail but actually happened during heavy testing
            catch {unset (control)}
            catch {unset (hidden)}                                                                                  ;# same as above
            catch {unset (xMagnet)}; catch {unset (yMagnet)}
            catch {unset (xOutline) (yOutline)}
            catch {unset (left) (rectangles)}
            catch {unset (xOffset)}; catch {unset (yOffset)}
        }

        proc resize {this width height} {
            # handle size should not be less than border width because of corners
            set size [maximum $composite::($this,-handlesize) $composite::($this,-borderwidth)]
            # recalculate handles limits
            # mid handle size is 1/3 of side but mid handles disappear when frame gets too small so that it stays movable

            set halfHeight [expr {$height / 2}]
            set ($this,topHandleBottom) [minimum $size $halfHeight]            ;# top corner handle bottom cannot exceed half height
            set ($this,bottomHandleTop) [expr {$height - $($this,topHandleBottom)}]
            # mid handle top cannot be to close to top corner handle bottom
            set ($this,midHandleTop) [maximum [expr {$height / 3}] [expr {$($this,topHandleBottom) + $size}]]
            # mid handle bottom limit cannot be greater than bottom corner handle top
            set ($this,midHandleBottom) [minimum [expr {(2 * $height) / 3}] [expr {$($this,bottomHandleTop) - $size}]]
            # note: mid handle top can be greater than mid handle bottom when handle disappears

            set halfWidth [expr {$width / 2}]
            set ($this,leftHandleRight) [minimum $size $halfWidth]              ;# left corner handle right cannot exceed half width
            set ($this,rightHandleLeft) [expr {$width - $($this,leftHandleRight)}]
            # mid handle left cannot be less than left corner handle right
            set ($this,midHandleLeft) [maximum [expr {$width / 3}] [expr {$($this,leftHandleRight) + $size}]]
            # mid handle right limit cannot be greater than right corner handle left
            set ($this,midHandleRight) [minimum [expr {(2 * $width) / 3}] [expr {$($this,rightHandleLeft) - $size}]]
            # note: mid handle left can be greater than mid handle right when handle disappears
        }

        proc setCursor {this x y} {
            if {[info exists (motion)]} {
                return    ;# make sure not to change cursor while moving outline (may happen when pointer passes over manager frame)
            }
            set border $composite::($this,-borderwidth)
            set path $widget::($this,path)
            set cursor fleur                                                                    ;# use moving cursor outside borders
            set direction {}
            if {$x < $border} {
                set side left
                set direction w
            } elseif {$x >= ([winfo width $path] - $border)} {
                set side right
                set direction e
            }
            if {[info exists side]} {                                                                        ;# in a vertical border
                if {$y < $($this,topHandleBottom)} {
                    set cursor top_${side}_corner
                    append direction n
                } elseif {$y > $($this,bottomHandleTop)} {
                    set cursor bottom_${side}_corner
                    append direction s
                } elseif {($y > $($this,midHandleTop)) && ($y < $($this,midHandleBottom))} {
                    set cursor ${side}_side
                } else {
                    set cursor fleur
                    set direction {}
                }
            } else {
                if {$y < $border} {
                    set side top
                    set direction n
                } elseif {$y >= ([winfo height $path] - $border)} {
                    set side bottom
                    set direction s
                }
                if {[info exists side]} {                                                                 ;# in an horizontal border
                    if {$x < $($this,leftHandleRight)} {
                        set cursor ${side}_left_corner
                        append direction w
                    } elseif {$x > $($this,rightHandleLeft)} {
                        set cursor ${side}_right_corner
                        append direction e
                    } elseif {($x > $($this,midHandleLeft)) && ($x < $($this,midHandleRight))} {
                        set cursor ${side}_side
                    } else {
                        set cursor fleur
                        set direction {}
                    }
                }
            }
            if {![string equal $cursor [$widget::($this,path) cget -cursor]]} {                    ;# update cursor only when needed
                $widget::($this,path) configure -cursor $cursor
                update idletasks                                                ;# make cursor immediately visible for user feedback
            }
            set ($this,direction) $direction
        }

        proc updateOutline {this x y} {                                                 ;# coordinates are relative to manager frame
            lifoLabel::pop $global::messenger                                                 ;# remove previous coordinates or size
            set canvas $($this,canvas)
            if {[llength [$canvas gettags outline]] == 0} return                    ;# unexpected, but happened during heavy testing
            if {![info exists (hidden)] || ![info exists ($this,direction)]} return                                 ;# same as above
            if {$(hidden)} {                                                                   ;# make sure outline is fully visible
                stackOutline $this raise
            }
            # make sure that pointer stays within canvas boundaries
            foreach {xFrame yFrame} [canvasWindowManager::coordinates $canvas $($this,item)] {}
            foreach {left top right bottom} [bounds $canvas] {}                                                    ;# reachable area
            if {($xFrame - $left + $x) < 0} {
                set x [expr {$left - $xFrame}]
            }
            if {($yFrame - $top + $y) < 0} {
                set y [expr {$top - $yFrame}]
            }
            set width [expr {$right - $left}]
            if {($xFrame - $left + $x) >= $width} {
                set x [expr {$width + $left - $xFrame - 1}]
            }
            set height [expr {$bottom - $top}]
            if {($yFrame - $top + $y) >= $height} {
                set y [expr {$height + $top - $yFrame - 1}]
            }
            set width [winfo width $widget::($this,path)]
            set height [winfo height $widget::($this,path)]
            if {[string length $($this,direction)] == 0} {                                                                 ;# moving
                moveOutline $canvas $x $y $width $height
                return
            }                                                                                         ;# else resizing handled below
            set xCursor [expr {$xFrame + $x}]; set yCursor [expr {$yFrame + $y}]                               ;# canvas coordinates
            switch $($this,direction) {
                n - s {
                    set offset [ySnapOffset $canvas $xCursor $yCursor $width]
                    if {[string length $offset] > 0} {incr y $offset}                                                        ;# snap
                }
                e - w {
                    set offset [xSnapOffset $canvas $xCursor $yCursor $height]
                    if {[string length $offset] > 0} {incr x $offset}                                                        ;# snap
                }
                default {
                    set offset [xSnapOffset $canvas $xCursor $yCursor $height]
                    if {[string length $offset] > 0} {incr x $offset}                                                        ;# snap
                    set offset [ySnapOffset $canvas $xCursor $yCursor $width]
                    if {[string length $offset] > 0} {incr y $offset}                                                        ;# snap
                }
            }
            switch $($this,direction) {
                nw - wn {
                    displayOutline $this [expr {$xFrame + $x}] [expr {$yFrame + $y}] [expr {$width - $x}] [expr {$height - $y}]
                }
                n {
                    displayOutline $this $xFrame [expr {$yFrame + $y}] $width [expr {$height - $y}]
                }
                ne - en {
                    displayOutline $this $xFrame [expr {$yFrame + $y}] $x [expr {$height - $y}]
                }
                e {
                    displayOutline $this $xFrame $yFrame $x $height
                }
                se - es {
                    displayOutline $this $xFrame $yFrame $x $y
                }
                s {
                    displayOutline $this $xFrame $yFrame $width $y
                }
                sw - ws {
                    displayOutline $this [expr {$xFrame + $x}] $yFrame [expr {$width - $x}] $y
                }
                w {
                    displayOutline $this [expr {$xFrame + $x}] $yFrame [expr {$width - $x}] $height
                }
            }
        }

        proc createOutline {this} {
            set canvas $($this,canvas)
            if {[llength [$canvas gettags outline]] > 0} return                     ;# unexpected, but happened during heavy testing
            # create outline borders (a single frame with no background cannot be used for it hides underlying windows)
            foreach side {top bottom left right} {
                if {[info exists ($side,item)]} continue                            ;# unexpected, but happened during heavy testing
                set frame [frame $canvas.${side}outline -background black]
                # items are static because there can be only 1 outline at a time
                set ($side,item) [$canvas create window 0 0 -window $frame -width 0 -height 0 -anchor nw -tags outline]
            }
            stackOutline $this lower                                                  ;# hide outline for now and make it fit widget
            eval displayOutline $this [$canvas coords $($this,item)]\
                [winfo width $widget::($this,path)] [winfo height $widget::($this,path)]
        }

        proc stackOutline {this order} {                                                      ;# order must be either raise or lower
            set canvas $($this,canvas)
            foreach side {top bottom left right} {
                $order [$canvas itemcget $($side,item) -window]
            }
            set (hidden) [string compare $order raise]
        }

        proc displayOutline {this x y width height} {                                          ;# coordinates are relative to canvas
            lifoLabel::push $global::messenger "$width x $height"                                ;# display new size in message area
            set minimum [expr {(2 * $composite::($this,-borderwidth)) + 1}]            ;# make sure managed widget is always visible
            set width [maximum $minimum $width]
            set height [maximum $minimum $height]
            set canvas $($this,canvas)
            $canvas coords $(top,item) $x $y
            $canvas coords $(bottom,item) $x [expr {$y + $height - 1}]
            $canvas coords $(left,item) $x $y
            $canvas coords $(right,item) [expr {$x + $width - 1}] $y
            $canvas itemconfigure $(top,item) -width $width
            $canvas itemconfigure $(bottom,item) -width $width
            $canvas itemconfigure $(left,item) -height $height
            $canvas itemconfigure $(right,item) -height $height
        }

        proc destroyOutline {this} {
            set canvas $($this,canvas)
            foreach side {top bottom left right} {
                if {![info exists ($side,item)]} continue                           ;# unexpected, but happened during heavy testing
                destroy [$canvas itemcget $($side,item) -window]                                               ;# destroy side frame
                unset ($side,item)
            }
            catch {$canvas delete outline}       ;# delete side items (should never fail but actually happened during heavy testing)
        }

        proc updateGeometry {this} {                ;# update managed widget position and size according to outline current geometry
            set canvas $($this,canvas)
            eval $canvas coords $($this,item) [$canvas coords outline]
            if {![info exists (top,item)] || ![info exists (left,item)]} return     ;# unexpected, but happened during heavy testing
            $canvas itemconfigure $($this,item) -width [$canvas itemcget $(top,item) -width]\
                -height [$canvas itemcget $(left,item) -height]
        }

        proc getGeometry {this} {                                                         ;# return x, y, width and height as a list
            return [concat\
                [$($this,canvas) coords $($this,item)]\
                [$($this,canvas) itemcget $($this,item) -width] [$($this,canvas) itemcget $($this,item) -height]\
            ]
        }

        proc stack {this order} {                                                             ;# order must be either raise or lower
            $order $widget::($this,path)
            if {[string length $composite::($this,-path)] > 0} {                                         ;# if managed widget exists
                raise $composite::($this,-path) $widget::($this,path)                                ;# maintain it just above frame
            }
            canvasWindowManager::stacked $($this,manager) $composite::($this,-path) [string compare $order lower]
        }

        proc stackLower {this handles} {                                                ;# invoked by window manager, so no callback
            lower $widget::($this,path) $widget::($handles,path)
            if {[string length $composite::($this,-path)] > 0} {                                         ;# if managed widget exists
                raise $composite::($this,-path) $widget::($this,path)                                ;# maintain it just above frame
            }
        }

        proc moveTo {this x y} {
            $($this,canvas) coords $($this,item) $x $y
        }

        proc updateMinimize {this} {
            if {![info exists ($this,minimize)]} return
            if {$composite::($this,-static)} {
                pack forget $widget::($($this,minimize),path)
            } else {
                pack $widget::($($this,minimize),path) -side right -before $($this,label)    ;# so that arrow always remains visible
            }
        }

        proc xSnapOffset {canvas x y height} { ;# return correction to be applied to reach the nearest magnet (empty if no snapping)
            if {$(control)} {return {}}                                                      ;# no snapping when control key is down
            set delta {}                                                                             ;# remains empty if no snapping
            set snap $global::snapDistance(window)
            foreach rectangle $(rectangles) {
                foreach {left top ignore size} [eval vectors $rectangle] {                                         ;# size is height
                    if {$size == 0} continue                                                              ;# skip horizontal vectors
                    if {(($y + $height) < $top) && ($y > ($top + $size))} continue                       ;# no vertical intersection
                    set value [expr {$left - $x}]
                    if {abs($value) < $snap} {
                        set delta $value
                        set snap [expr {abs($value)}]
                    }
                }
            }
            return $delta                                                                  ;# return offset (empty if no attraction)
        }
        proc ySnapOffset {canvas x y width} {  ;# return correction to be applied to reach the nearest magnet (empty if no snapping)
            if {$(control)} {return {}}                                                      ;# no snapping when control key is down
            set delta {}                                                                             ;# remains empty if no snapping
            set snap $global::snapDistance(window)
            foreach rectangle $(rectangles) {
                foreach {left top size ignore} [eval vectors $rectangle] {                                          ;# size is width
                    if {$size == 0} continue                                                                ;# skip vertical vectors
                    if {(($x + $width) < $left) && ($x > ($left + $size))} continue                    ;# no horizontal intersection
                    set value [expr {$top - $y}]
                    if {abs($value) < $snap} {
                        set delta $value
                        set snap [expr {abs($value)}]
                    }
                }
            }
            return $delta                                                                  ;# return offset (empty if no attraction)
        }

        proc moveOutline {canvas x y width height} {
            set xDelta [expr {$x - $(xLast)}]
            if {[info exists (xMagnet)]} {                                                                                ;# snapped
                incr (xMagnet) $xDelta
                set offset [xOffset $canvas $(xMagnet) $(yOutline) $width $height]
                if {[string length $offset] == 0} {                                                          ;# out of magnets range
                    set xDelta [expr {$(xMagnet) - $(xOutline)}]                                                         ;# catch up
                    unset (xMagnet)
                } elseif {abs($offset) < abs($(xOffset))} {                                                 ;# found a closer magnet
                    set xDelta [expr {$(xMagnet) - $(xOutline)}]                                                         ;# catch up
                    incr xDelta $offset
                    set (xMagnet) [expr {$(xOutline) + $xDelta}]                      ;# position outline exactly at target location
                } else {
                    set xDelta 0
                }
            } else {                                                                                            ;# outline is moving
                set offset [xOffset $canvas [expr {$(xOutline) + $xDelta}] $(yOutline) $width $height]
                if {[string length $offset] > 0} {                                                         ;# snap to nearest magnet
                    incr xDelta $offset
                    set (xMagnet) [expr {$(xOutline) + $xDelta}]                      ;# position outline exactly at target location
                }
            }
            set (xOffset) $offset                                                                       ;# keep track of last offset
            set yDelta [expr {$y - $(yLast)}]
            if {[info exists (yMagnet)]} {                                                                                ;# snapped
                incr (yMagnet) $yDelta
                set offset [yOffset $canvas $(xOutline) $(yMagnet) $width $height]
                if {[string length $offset] == 0} {                                                          ;# out of magnets range
                    set yDelta [expr {$(yMagnet) - $(yOutline)}]                                                         ;# catch up
                    unset (yMagnet)
                } elseif {abs($offset) < abs($(yOffset))} {                                                 ;# found a closer magnet
                    set yDelta [expr {$(yMagnet) - $(yOutline)}]                                                         ;# catch up
                    incr yDelta $offset
                    set (yMagnet) [expr {$(yOutline) + $yDelta}]                      ;# position outline exactly at target location
                } else {
                    set yDelta 0
                }
            } else {                                                                                            ;# outline is moving
                set offset [yOffset $canvas $(xOutline) [expr {$(yOutline) + $yDelta}] $width $height]
                if {[string length $offset] > 0} {                                                         ;# snap to nearest magnet
                    incr yDelta $offset
                    set (yMagnet) [expr {$(yOutline) + $yDelta}]                      ;# position outline exactly at target location
                }
            }
            set (yOffset) $offset                                                                       ;# keep track of last offset
            $canvas move outline $xDelta $yDelta
            fence $canvas outline
            incr (xOutline) $xDelta; incr (yOutline) $yDelta
            set (xLast) $x; set (yLast) $y
            foreach {x y} [$canvas coords outline] break                                            ;# finally show real coordinates
            lifoLabel::push $global::messenger "[expr {round($x) - [lindex [$canvas cget -scrollregion] 0]}] [expr {round($y)}]"
        }

        proc xOffset {canvas x y width height} {
            set left [xSnapOffset $canvas $x $y $height]
            set right [xSnapOffset $canvas [incr x $width] $y $height]
            if {[string length $left] == 0} {
                if {[string length $right] == 0} {return {}} else {return $right}
            } else {
                if {([string length $right] == 0) || (abs($left) < abs($right))} {return $left} else {return $right}
            }
        }
        proc yOffset {canvas x y width height} {
            set top [ySnapOffset $canvas $x $y $width]
            set bottom [ySnapOffset $canvas $x [incr y $height] $width]
            if {[string length $top] == 0} {
                if {[string length $bottom] == 0} {return {}} else {return $bottom}
            } else {
                if {([string length $bottom] == 0) || (abs($top) < abs($bottom))} {return $top} else {return $bottom}
            }
        }

    }

}