# copyright (C) 1997-2006 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: canvaswm.tcl,v 2.71 2006/01/28 19:16:59 jfontain Exp $


class canvasWindowManager {

    proc canvasWindowManager {this canvas} {
        # used for icons (minimized objects) in the canvas window manager context, also used by canvas viewers
        set ($this,drag) [new dragSite -path $canvas -validcommand "canvasWindowManager::validateDrag $this" -grab 0]
        set ($this,canvas) $canvas
    }

    proc ~canvasWindowManager {this} {
        variable ${this}data
        variable ${this}handleIcon
        variable ${this}handleCoordinates
        variable ${this}handleIconCoordinates

        foreach {handle icon} [array get ${this}handleIcon] {
            delete $icon
        }
        foreach {name handle} [array get ${this}data handle,*] {
            delete $handle
        }
        unset -nocomplain ${this}data ${this}handleIcon ${this}handleCoordinates ${this}handleIconCoordinates
        delete $($this,drag)
    }

    proc manage {this path viewer} {                                           ;# viewer, table or database cell histories container
        variable ${this}data

        set handle [new handles $($this,canvas) $this -path $path]
        set ${this}data(handle,$path) $handle
        set ${this}data(viewerHandle,$viewer) $handle                                           ;# a viewer can have one handle only
    }

    proc unmanage {this path} {
        variable ${this}data
        variable ${this}handleIcon
        variable ${this}handleCoordinates
        variable ${this}handleIconCoordinates

        set handle [set ${this}data(handle,$path)]
        if {[info exists ${this}handleIcon($handle)]} {                                                                 ;# minimized
            delete [set ${this}handleIcon($handle)]                                                                   ;# delete icon
            unset ${this}handleIcon($handle)
            unset -nocomplain ${this}handleIconCoordinates($handle)
        }
        unset -nocomplain ${this}handleCoordinates($handle)
        foreach {name value} [array get ${this}data viewerHandle,*] {
            if {$value == $handle} {array unset ${this}data $name; break}
        }
        delete $handle
        unset ${this}data(handle,$path) ${this}data(relativeStackingLevel,$path)
    }

    proc configure {this path args} {
        variable ${this}data

        set handle [set ${this}data(handle,$path)]
        array set value $args
        if {![catch {string length $value(-level)} length] && ($length > 0)} {
            # find out which managed widget to stack right below, if any. if none is found, widget defaults to top stack level
            set names [array names ${this}data relativeStackingLevel,*]
            if {[llength $names] > 0} {                                                           ;# there are other managed widgets
                foreach name $names {                                                               ;# build path from level mapping
                    set pathFrom([set ${this}data($name)]) [lindex [split $name ,] end]
                }
                foreach level [lsort -integer [array names pathFrom]] {
                    if {$level > $value(-level)} {
                        handles::stackLower $handle [set ${this}data(handle,$pathFrom($level))]
                        break                                                            ;# found the handles for widget right above
                    }
                }
            }
            set ${this}data(relativeStackingLevel,$path) $value(-level)
        }
        catch {set xIcon $value(-iconx); set yIcon $value(-icony)}
        unset -nocomplain value(-level)                                                    ;# handles do not handle the level option
        unset -nocomplain value(-iconx) value(-icony)                                                    ;# nor the icon coordinates
        if {![catch {set object $value(-dragobject)}]} {
            composite::configure $handle -dragobject $object
            unset value(-dragobject)
        }
        eval composite::configure $handle [array get value]
        ::update idletasks                    ;# so that handles return correct geometry even when immediately minimized right below
        if {[info exists xIcon] && ($xIcon ne "")} {                                     ;# icon coordinates are defined so minimize
            minimize $this $handle [composite::cget $handle -title] $xIcon $yIcon $value(-static)
        }
    }

    proc getGeometry {this path} {                                                        ;# return x, y, width and height as a list
        variable ${this}data
        variable ${this}handleIcon
        variable ${this}handleCoordinates

        set handle [set ${this}data(handle,$path)]
        set geometry [handles::getGeometry $handle]
        if {[info exists ${this}handleIcon($handle)]} {                                                                 ;# minimized
            # return coordinates before minimization:
            return [eval lreplace [list $geometry] 0 1 [set ${this}handleCoordinates($handle)]]
        } else {
            return $geometry
        }
    }

    proc getStackLevel {this path} {                                                               ;# return relative stacking level
        variable ${this}data

        return [set ${this}data(relativeStackingLevel,$path)]
    }

    proc getTitle {this path} {                                        ;# note: this may fail and must throw an error if not managed
        variable ${this}data

        return [composite::cget [set ${this}data(handle,$path)] -title]
    }

    proc iconCoordinates {this path} {
        variable ${this}data
        variable ${this}handleIcon

        set handle [set ${this}data(handle,$path)]
        if {[catch {set icon [set ${this}handleIcon($handle)]}]} {                                                  ;# not minimized
            return [list {} {}]                                                                       ;# list of 2 empty coordinates
        } else {
            return [icon::coordinates $icon]
        }
    }

    proc relativeStackingLevels {this} {                                  ;# return paths relative levels sorted in increasing order
        variable ${this}data

        set list {}
        foreach {name value} [array get ${this}data relativeStackingLevel,*] {
            lappend list $value
        }
        return [lsort -integer $list]
    }

    proc stacked {this path raised} {                           ;# parameter is a boolean: either raised to top or lowered to bottom
        variable ${this}data

        set levels [relativeStackingLevels $this]
        if {[llength $levels] == 0} {                                                              ;# first widget to be positionned
            set ${this}data(relativeStackingLevel,$path) 0
        } elseif {$raised} {
            set ${this}data(relativeStackingLevel,$path) [expr {[lindex $levels end] + 1}]        ;# place right above maximum level
        } else {
            set ${this}data(relativeStackingLevel,$path) [expr {[lindex $levels 0] - 1}]          ;# place right below minimum level
        }
    }

    proc raisedOnTop {this path} {
        variable ${this}data

        return [expr {[set ${this}data(relativeStackingLevel,$path)] >= [lindex [relativeStackingLevels $this] end]}]
    }

    proc raise {this next} {                                                              ;# next is a boolean: false means previous
        variable ${this}data
        variable ${this}handleIcon

        set canvas $($this,canvas)
        set bounds [bounds $canvas]                                                                              ;# for current page
        set handles {}
        foreach {name handle} [array get ${this}data handle,*] {
            if {[info exists ${this}handleIcon($handle)]} continue                                       ;# ignore minimized handles
            if {![intersect [$canvas bbox $handles::($handle,item)] $bounds]} continue              ;# ignore handles in other pages
            set path($handle) [scan $name handle,%s]
            lappend handles $handle
        }
        set length [llength $handles]
        if {$length < 2} {
            raiseOther $this $next                                                                    ;# try icons and other objects
            return                                                                        ;# there can be no next or previous handle
        }
        set handles [lsort -integer $handles]                                                           ;# sort in order of creation
        set maximum $global::32BitIntegerMinimum
        set index 0
        foreach handle $handles {
            set level [set ${this}data(relativeStackingLevel,$path($handle))]
            if {$level > $maximum} {
                set maximum $level
                set top $index
            }
            incr index
        }
        if {$next} {
            if {[incr top] >= $length} {                                                               ;# circle around to beginning
                if {[raiseOther $this 1]} return                                       ;# except if there were other objects to show
                set top 0
            }
        } else {
            if {[incr top -1] < 0} {                                                                    ;# circle around back to end
                if {[raiseOther $this 0]} return                                       ;# except if there were other objects to show
                set top end
            }
        }
        handles::stack [lindex $handles $top] raise
    }

    proc raiseOther {this next} {
        variable ${this}data
        variable ${this}handleIcon

        set canvas $($this,canvas)
        set bounds [bounds $canvas]                                                                              ;# for current page
        set handles {}
        foreach {name handle} [array get ${this}data handle,*] {
            if {[catch {set tag icon([set ${this}handleIcon($handle)])}]} continue                                  ;# not minimized
            if {![intersect [$canvas bbox $tag] $bounds]} continue                                  ;# ignore objects in other pages
            lappend handles $handle
        }
        set tags {}
        foreach handle [lsort -integer $handles] {                                                      ;# sort in order of creation
            lappend tags icon([set ${this}handleIcon($handle)])
        }
        foreach viewer $canvas::viewer::(list) {                                                       ;# now look at canvas viewers
            set tag $canvas::viewer::($viewer,tag)
            if {![intersect [$canvas bbox $tag] $bounds]} continue                                  ;# ignore viewers in other pages
            lappend tags $tag
        }
        if {[llength $tags] == 0} {return 0}                                                                 ;# nothing to highlight
        if {[info exists ($this,raiseOtherEvent)]} {                                                 ;# an icon is being highlighted
            set command [lindex [after info $($this,raiseOtherEvent)] 0]
            after cancel $($this,raiseOtherEvent)                                                            ;# cancel current event
            uplevel #0 $command                                                                      ;# but still execute its script
            set index [lsearch -exact $tags $($this,raiseOtherTag)]
            if {$index < 0} {                                                              ;# object may have disappeared (unlikely)
                if {$next} {set index 0} else {set index end}
            } elseif {$next} {
                if {[incr index] >= [llength $tags]} {unset index}                                    ;# no next object to highlight
            } else {
                if {[incr index -1] < 0} {unset index}                                                ;# no next object to highlight
            }
        } else {                                                                                          ;# start at extreme object
            if {$next} {set index 0} else {set index end}
        }
        if {![info exists index]} {                                                                   ;# no next object to highlight
            unset ($this,raiseOtherTag)
            return 0
        }
        set ($this,raiseOtherTag) [lindex $tags $index]
        foreach {left top right bottom} [$canvas bbox $($this,raiseOtherTag)] {}
        set highlighter [new highlighter]
        highlighter::show $highlighter\
            [expr {[winfo rootx $canvas] + $left}] [expr {[winfo rooty $canvas] + $top}]\
            [expr {$right - $left}] [expr {$bottom - $top}]
        set ($this,raiseOtherEvent) [after 1000 "delete $highlighter; unset canvasWindowManager::($this,raiseOtherEvent)"]
        return 1
    }

    proc see {this path} {
        variable ${this}data
        variable ${this}handleIcon

        set handle [set ${this}data(handle,$path)]
        if {[info exists ${this}handleIcon($handle)]} {                                                                 ;# minimized
            deIconify $this $handle
        } else {
            handles::stack $handle raise
        }
    }

    proc minimize {this handle title {xIcon {}} {yIcon {}} {static 0}} {
        variable ${this}handleIcon
        variable ${this}handleCoordinates
        variable ${this}handleIconCoordinates

        foreach {x y} [handles::getGeometry $handle] break                                           ;# retrieve current coordinates
        set ${this}handleCoordinates($handle) [list $x $y]                                                          ;# remember them
        handles::moveTo $handle $global::32BitIntegerMinimum $global::32BitIntegerMinimum       ;# make window invisible to the user
        set icon [new icon $($this,canvas) $title -command "canvasWindowManager::deIconify $this $handle"]
        if {$static} {switched::configure $icon -state disabled} else {switched::configure $icon -state normal}
        if {$xIcon ne ""} {
            icon::coordinates $icon $xIcon $yIcon                                                         ;# pre-defined coordinates
            set ${this}handleIconCoordinates($handle) [list $xIcon $yIcon]                    ;# remember them for next minimization
        } elseif {[info exists ${this}handleIconCoordinates($handle)]} {                                            ;# if available,
            eval icon::coordinates $icon [set ${this}handleIconCoordinates($handle)]                ;# use previous icon coordinates
        } else {
            stowIcon $this $icon
        }
        switched::configure $icon -color [composite::cget $handle -titlebackground]
        set ${this}handleIcon($handle) $icon
    }

    proc deIconify {this handle} {
        variable ${this}handleIcon
        variable ${this}handleCoordinates
        variable ${this}handleIconCoordinates

        set icon [set ${this}handleIcon($handle)]
        if {$icon::($icon,moved)} {                                                                        ;# icon was moved by user
            set ${this}handleIconCoordinates($handle) [icon::coordinates $icon]    ;# remember its coordinates for next minimization
        }
        composite::configure $handle -titlebackground [switched::cget $icon -color]
        delete $icon
        eval handles::moveTo $handle [set ${this}handleCoordinates($handle)]                      ;# place back in original position
        handles::stack $handle raise                                      ;# but on top of the others so that it can be easily found
        unset ${this}handleIcon($handle) ${this}handleCoordinates($handle)
    }

    proc stowIcon {this identifier} {                ;# place icon at the bottom left of the canvas current page where there is room
        set canvas $($this,canvas)
        set padding $global::iconPadding
        ::update idletasks                                                                      ;# needed to get canvas correct size
        set bounds [bounds $canvas]                                                                              ;# for current page
        foreach {region(left) region(top) region(right) region(bottom)} $bounds {}
        foreach item [$canvas find all] {
            set index 0
            foreach tag [$canvas gettags $item] {
                if {[scan $tag icon(%u) index] > 0} break                                                           ;# found an icon
            }
            if {($index == 0) || ($index == $identifier)} continue                     ;# ignore items other than icons and new icon
            if {![intersect [$canvas bbox icon($index)] $bounds]} continue                            ;# ignore icons in other pages
            set found($index) {}             ;# eliminate duplicates (an icon may be composed of several elements with the same tag)
        }
        set coordinates {}
        foreach index [array names found] {
            lappend coordinates [$canvas bbox icon($index)]
        }
        set coordinates [lsort -integer -index 0 $coordinates]                                                  ;# order by abscissa
        foreach {left top right bottom} [$canvas bbox icon($identifier)] {}                        ;# all icons have the same height
        set height [expr {$bottom - $top + (2 * $padding)}]  ;# icons are initially placed in slices with a reasonable padding value
        set width [expr {$right - $left + (2 * $padding)}]
        set maximum $region(bottom)
        while {[set minimum [expr {$maximum - $height}]] >= 0} {                 ;# look for room in slices starting from the bottom
            set spaces {}                                                              ;# build a list a empty segments in the slice
            set x $region(left)                                                          ;# the right side of the last occupied area
            foreach list $coordinates {
                foreach {left top right bottom} $list {}
                if {($top > $maximum) || ($bottom < $minimum)} continue                    ;# icon area does not intersect the slice
                if {$left > $x} {                                                                           ;# an empty space exists
                    lappend spaces $x $left
                }
                set x $right
            }
            if {$x < $region(right)} {
                lappend spaces $x $region(right)                                  ;# space remaining on the right slice of the slice
            }
            # find out whether there is a wide enough empty area in the slice to contain the new icon:
            foreach {left right} $spaces {
                if {($right - $left) > $width} {
                    set position(x) $left
                    set position(y) $minimum
                    break                                                                           ;# a wide enough space was found
                }
            }
            if {[info exists position]} break                                                             ;# a valid space was found
            set maximum $minimum                                                                        ;# look in the next slice up
        }
        # if no large enough empty area was found (unlikely), place the icon at the bottom left corner, maybe on top of other ones:
        if {![info exists position]} {
            set position(x) [expr {$region(left)}]
            set position(y) [expr {$region(bottom) - $height}]
        }
        # place top left corner of icon at calculated coordinates
        foreach {x y} [icon::coordinates $identifier] {}
        foreach {left top right bottom} [$canvas bbox icon($identifier)] {}
        icon::coordinates $identifier [expr {$position(x) + ($x - $left)}] [expr {$position(y) + ($y - $top)}]
    }

    # return the page where the viewer or table lies or nothing if failure, such as the object not being managed
    proc viewerPage {this object} {                                                                                    ;# identifier
        variable ${this}data
        variable ${this}handleIcon

        if {[catch {set handle [set ${this}data(viewerHandle,$object)]}]} {
            return {}                                                                                       ;# object is not managed
        }
        set tag $handles::($handle,item)
        catch {set tag icon([set ${this}handleIcon($handle)])}                                            ;# handle may be minimized
        return [pages::tagOrItemPage $tag]
    }

    proc handles {this} {                                                                  ;# returns a list of the existing handles
        variable ${this}data

        set list {}
        foreach {name handle} [array get ${this}data handle,*] {
            lappend list $handle
        }
        return $list
    }

    # list of rectangles (borders of managed windows) from the same page, including visible canvas rectangle
    proc rectangles {this exclude} {                                                                            ;# handle to exclude
        variable ${this}handleIcon

        set canvas $($this,canvas)
        set page [pages::tagOrItemPage $handles::($exclude,item)]
        set list {}
        foreach handle [handles $this] {
            if {($handle == $exclude) || [info exists ${this}handleIcon($handle)]} continue                             ;# minimized
            set item $handles::($handle,item)
            if {[pages::tagOrItemPage $item] ne $page} continue                           ;# page may be empty if there are no pages
            foreach {x y} [coordinates $canvas $item] {}
            lappend list [list $x $y [winfo width $widget::($handle,path)] [winfo height $widget::($handle,path)]]
        }
        return $list
    }

    proc coordinates {canvas itemOrTag} {                                                ;# return coordinates in pixels as integers
        set values {}
        foreach value [$canvas coords $itemOrTag] {
            lappend values [expr {round($value)}]
        }
        return $values
    }

    proc validateDrag {this x y} {
        variable ${this}handleIcon

        set drag $($this,drag)
        set canvas $($this,canvas)
        # reset all formats as they are dynamically defined in order to handle different canvas object types
        foreach format [dragSite::provide $drag] {dragSite::provide $drag $format {}}
        foreach tag [$canvas gettags current] {
            if {[set icon [icon::fromTag $tag]] > 0} {                                            ;# a minimized object was selected
                set handle 0
                foreach {name value} [array get ${this}handleIcon] {
                    if {$value == $icon} {set handle $name; break}
                }
                if {$handle == 0} {error {could not find a handle for selected icon}}
                dragSite::provide $drag MINIMIZED "dragEcho [list [list $this $handle $icon]]"     ;# allow dropping in another page
                return 1
            }
        }
        return [canvas::viewer::validateDrag $canvas $x $y]                               ;# see if a canvas viewer is being dragged
    }

    proc dragData {this format} {                                     ;# note: minimized window manager objects are handled directly
        return [canvas::viewer::dragData $($this,canvas) $format]
    }

    proc moveIconToPage {list x y} {                                                             ;# list of manager, handle and icon
        foreach {manager handle icon} $list {}
        variable ${manager}handleCoordinates
        set ${manager}handleCoordinates($handle) [list $x $y]                             ;# so that it deiconifies in the same page
        icon::coordinates $icon $x $y
    }

    proc moveHandlesToPage {handles x y} {
        set manager $global::windowManager
        variable ${manager}handleCoordinates
        variable ${manager}handleIconCoordinates
        set ${manager}handleCoordinates($handles) [list $x $y]
        unset -nocomplain ${manager}handleIconCoordinates($handles)                 ;# previous icon coordinates are no longer valid
        handles::moveTo $handles $x $y
    }

    proc moveAll {this xMaximum} {
        variable ${this}handleIcon

        foreach handle [handles $this] {
            if {![catch {set icon [set ${this}handleIcon($handle)]}]} {                                                 ;# minimized
                foreach {x y} [icon::coordinates $icon] {}
                if {$x >= $xMaximum} {
                    moveIconToPage [list $this $handle $icon] [expr {round($x) % $xMaximum}] $y
                }
            } else {
                foreach {x y} [canvasWindowManager::handles::getGeometry $handle] break
                if {$x >= $xMaximum} {
                    moveHandlesToPage $handle [expr {round($x) % $xMaximum}] $y
                }
            }
        }
    }

    proc colorTagged {this tags value} {
        variable ${this}handleIcon

        foreach handle [handles $this] {
            set match 0
            foreach tag $tags {
                if {[lsearch -exact [composite::cget $handle -tags] $tag] >= 0} {set match 1; break}
            }
            if {!$match} continue
            if {[catch {set icon [set ${this}handleIcon($handle)]}]} {
                composite::configure $handle -titlebackground $value
            } else {                                                                                                    ;# minimized
                switched::configure $icon -color $value
            }
        }
    }

}
