# ibisa - Image-Based Identification/Search for Archaeology
# Copyright (C) 2008, 2009 Anthony Beurive'

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#----------------------------------------------------------------------

# This package provides the icanvas namespace.  It encapsulates Tk
# canvases into new commands with additional features, such as item
# hierarchy, automatic grid placement, round rectangles, etc.
# However, not all use cases have been tested, so there may remain
# undefined behavior here and there.

package provide icanvas 1.0

package require Tk
package require map
package require color
package require chrono

# Idea: the item hierarchy has a uniform "meaning".  However, in some
# circumstances we would like a node to behave in specific ways (like
# for 'find' or 'itemconfigure').  This behavior should be modular
# (unlike current round rectangles which are hard-coded).


# Idea: when an item has been geometrically changed it might be
# interesting to automatically trigger the places involving this item.


namespace eval ::icanvas {
    variable code.template
}

set ::icanvas::code.template {

    proc ::%CANVAS% {cmd args} {
        set targets [info procs ::icanvas::$cmd]
        if {[llength $targets] == 0} {
            return [eval %_CANVAS% $cmd $args]
        }
        foreach target $targets {
            return [eval $target %CANVAS% $args]
        }
    }
}

proc ::icanvas {path args} {
    eval ::icanvas::new $path $args
}

proc ::icanvas::new {canvas args} {
    eval canvas $canvas $args

    # Move the canvas procedure into the icanvas namespace.
    set _canvas ::icanvas::_$canvas
    rename $canvas $_canvas

    # Create a new canvas procedure in the global namespace.
    variable code.template
    lappend mapping %CANVAS% $canvas
    lappend mapping %_CANVAS% $_canvas
    uplevel #0 [string map $mapping ${code.template}]

    ::map::array:variable $canvas:vars
    $canvas:vars:set grid:cell:min:size 32
    $canvas:vars:set places:update:lock 0
    $canvas:vars:set draw:grid:rulers 0
    $canvas:vars:set draw:grid:text 0
    $canvas:vars:set debug 0

    ::map::array:variable $canvas:parents
    ::map::array:variable $canvas:children
    ::map::array:variable $canvas:places
    ::map::array:variable $canvas:place:callbacks
    ::map::array:variable $canvas:size:set:callbacks

    ::map::array:variable $canvas:free:regions

    bind $canvas <Destroy> { ::icanvas::destroy %W }
    bind $canvas <Configure> { ::icanvas::configure:event %W }
    return $canvas
}

proc ::icanvas::destroy {canvas} {
    foreach map {
        vars
        parents
        children
        places
        place:callbacks
        size:set:callbacks
        free:regions
    } {
        $canvas:$map:clear
    }
}

#----------------------------------------------------------------------
# Overridden features.

proc ::icanvas::addtag {canvas tag search args} {
    set ids [eval find $canvas $search $args]
    foreach id $ids {
        eval _$canvas addtag $tag withtag $id
    }
}

proc ::icanvas::find {canvas search args} {
    switch $search {

        hierarchy {
            set result {}

            # Hierarchy-search collects both tags and IDs, starting at
            # the given root(s) and going through all the descendants.
            set items $args

            while {[llength $items] > 0} {
                set item [lindex $items 0]
                set items [lreplace $items 0 0]
                if {[array get visited $item] != {}} continue
                lappend result $item
                set visited($item) 1

                set new {}
                # Add children.
                eval lappend new [children $canvas $item]
                # Add IDs.
                eval lappend new [_$canvas find withtag $item]

                if {[llength $new] > 0} {
                    eval lappend new $items
                    set items $new
                }
            }

            return $result
        }

        withtag {
            set result {}

            # Withtag-search considers the hierarchy too, but only
            # returns IDs.
            set items [find $canvas hierarchy [lindex $args 0]]

            for {set i 0} {$i < [llength $items]} {incr i} {
                set item [lindex $items $i]
                foreach id [_$canvas find withtag $item] {
                    if {[array get visited $id] != {}} continue
                    lappend result $id
                    set visited($id) 1
                }
            }

            return $result
        }

        # FIXME: maybe other search methods should be implemented with
        # hierarchy in mind.

        default {
            # Fall to encapsulated canvas.
            return [eval _$canvas find $search $args]
        }
    }
}

proc ::icanvas::delete {canvas args} {
    # Collect items to delete.
    set items [eval find $canvas hierarchy $args]

    # Fix hierarchy.
    foreach item $items {
        remove:parents $canvas $item
    }

    # Remove corresponding map keys.
    foreach map {
        vars
        parents
        children
        places
        place:callbacks
        size:set:callbacks
        free:regions
    } {
        foreach item $items {
            $canvas:$map:unset $item
        }
    }

    # Delete items in encapsulated canvas.
    eval _$canvas delete $items
}

proc ::icanvas::create {canvas type args} {
    if {$type == "round:rectangle"} {
        # TclMagick was removed.  Use normal rectangles.
        set type rectangle
        #return [eval round:rectangle:create $canvas $args]
    }

    return [eval _$canvas create $type $args]
}

proc ::icanvas::coords {canvas tagOrId args} {
    set item $tagOrId

    # Look for the first item which shows coordinates.
    set coords [_$canvas coords $item]
    if {$coords == ""} {
        # Look in hierarchy.
        set items [find $canvas hierarchy $item]
        foreach item $items {
            set coords [_$canvas coords $item]
            if {$coords != ""} break
        }
    }

    # Branch if round rectangle.
    set id [lindex [_$canvas find withtag $item] 0]
    if [round:rectangle:test $canvas $id] {
        return [eval round:rectangle:coords $canvas $id $args]
    }

    # Fall to encapsulated canvas.
    return [eval _$canvas coords $item $args]
}

proc ::icanvas::itemcget {canvas tagOrId args} {
    set id [lindex [find $canvas withtag $tagOrId] 0]
    if [round:rectangle:test $canvas $id] {
        return [eval round:rectangle:itemcget $canvas $id $args]
    }

    return [eval _$canvas itemcget $tagOrId $args]
}

proc ::icanvas::itemconfigure {canvas tagOrId args} {
    if {[llength $args] == 0} {
        set id [lindex [find $canvas withtag $tagOrId] 0]
        if [round:rectangle:test $canvas $id] {
            return [round:rectangle:itemconfigure $canvas $id]
        }
        return [eval _$canvas itemconfigure $tagOrId]

    } else {
        set ids [find $canvas withtag $tagOrId]
        foreach id $ids {
            if [round:rectangle:test $canvas $id] {
                eval round:rectangle:itemconfigure $canvas $id $args
            } else {
                eval _$canvas itemconfigure $id $args
            }
        }
    }
}

set ::icanvas::tagOrId.proc.template {
    proc ::icanvas::%PROC% {canvas tagOrId args} {
        set tag $tagOrId:%PROC%
        foreach id [find $canvas withtag $tagOrId] {
            _$canvas addtag $tag withtag $id
        }
        set result [eval _$canvas %PROC% $tag $args]
        _$canvas dtag $tag
        return $result
    }
}

# Other procedures which use a tag or ID on the same basis.
foreach p {bbox lower move raise} {
    set mapping [list %PROC% $p]
    uplevel #0 [string map $mapping ${::icanvas::tagOrId.proc.template}]
}

#----------------------------------------------------------------------
# New features.


# Item hierarchy.

proc ::icanvas::add:children {canvas tagOrId args} {
    set children [$canvas:children:get $tagOrId]

    foreach tag $args {
        if {[lsearch -exact $children $tag] == -1} {
            lappend children $tag
        }

        set parents [$canvas:parents:get $tag]
        if {[lsearch -exact $parents $tagOrId] == -1} {
            lappend parents $tagOrId
            $canvas:parents:set $tag $parents
        }
    }

    $canvas:children:set $tagOrId $children
}

proc ::icanvas::remove:children {canvas tagOrId args} {
    set children [$canvas:children:get $tagOrId]
    set new:children {}

    set remove $args
    if {[llength $remove] == 0} {
        set remove $children
    }

    foreach child $children {
        if {[lsearch -exact $remove $child] == -1} {
            lappend new:children $child
            continue
        }

        set parents [$canvas:parents:get $child]
        set new:parents {}
        foreach parent $parents {
            if {$parent == $tagOrId} continue
            lappend new:parents $parent
        }
        $canvas:parents:set $child ${new:parents}
    }

    $canvas:children:set $tagOrId ${new:children}
}

proc ::icanvas::remove:parents {canvas tagOrId args} {
    set remove $args
    if {[llength $remove] == 0} {
        set remove [$canvas:parents:get $tagOrId]
    }
    foreach parent $remove {
        remove:children $canvas $parent $tagOrId
    }
}

proc ::icanvas::children {canvas tagOrId} {
    return [$canvas:children:get $tagOrId]
}

proc ::icanvas::parents {canvas tagOrId} {
    return [$canvas:parents:get $tagOrId]
}

proc ::icanvas::connected:elements {canvas tagOrId towards} {
    set result {}
    set elements [$towards $canvas $tagOrId]

    while {[llength $elements] > 0} {
        set element [lindex $elements 0]
        set elements [lreplace $elements 0 0]
        if {[array get visited $element] != {}} continue
        lappend result $element
        set visited($element) 1

        set new [$towards $canvas $element]
        if {[llength $new] > 0} {
            eval lappend new $elements
            set elements $new
        }
    }
    return $result
}

proc ::icanvas::descendants {canvas tagOrId} {
    return [connected:elements $canvas $tagOrId children]
}

proc ::icanvas::ancestors {canvas tagOrId} {
    return [connected:elements $canvas $tagOrId parents]
}

proc ::icanvas::extreme:elements {canvas towards args} {
    set result {}

    set elements $args
    if {[llength $elements] == 0} {
        eval lappend elements [$canvas:children:keys]
        eval lappend elements [$canvas:parents:keys]
        eval lappend elements [$canvas:places:keys]
        eval lappend elements [_$canvas find withtag all]
    }

    while {[llength $elements] > 0} {
        set element [lindex $elements 0]
        set elements [lreplace $elements 0 0]
        if {[array get visited $element] != {}} continue
        set visited($element) 1

        set new [$towards $canvas $element]
        if {[llength $new] > 0} {
            eval lappend new $elements
            set elements $new
        } else {
            lappend result $element
        }
    }

    return $result
}

proc ::icanvas::roots {canvas args} {
    return [eval extreme:elements $canvas parents $args]
}

proc ::icanvas::leaves {canvas args} {
    return [eval extreme:elements $canvas children $args]
}


# Places.

proc ::icanvas::place:set {canvas op tagOrId args} {
    set cmd [eval list $op $tagOrId $args]
    $canvas:places:set $tagOrId $cmd
}

proc ::icanvas::place:callback {canvas tagOrId callback args} {
    $canvas:place:callbacks:set $tagOrId [eval list $callback $args]
}

proc ::icanvas::place:get {canvas tagOrId} {
    $canvas:places:get $tagOrId
}

proc ::icanvas::place:delete {canvas tagOrId} {
    $canvas:places:unset $tagOrId
}

proc ::icanvas::places:update {canvas} {
    set debug [$canvas:vars:get debug]
    if $debug {
        places:update:debug $canvas "start of places:update"
        ::chrono::trigger
    }

    set lock [$canvas:vars:get places:update:lock]
    if {$lock > 1} {
        puts "lock $lock"
        return
    }

    $canvas:vars:set places:update:lock [expr $lock + 1]
    while {[$canvas:vars:get places:update:lock] > 1} {
        ::chrono::sleep 0.1
    }

    grid:delete $canvas
    set commands {}
    set callbacks {}

    # FIXME: places form a constraint graph which may still be
    # inconsistant after the update.

    # Proceed through hierarchy.
    set items [$canvas:places:keys]
    set items [eval roots $canvas $items]

    while {[llength $items] > 0} {
        set item [lindex $items 0]
        set items [lreplace $items 0 0]
        if {[array get visited $item] != {}} continue
        set visited($item) 1

        set cmd [$canvas:places:get $item]
        if {$cmd != {}} {
            # Collect commands.
            lappend commands $cmd
        }

        set callback [$canvas:place:callbacks:get $item]
        if {$callback != {}} {
            lappend callbacks $callback
        }

        # Enlist the children.
        set new [children $canvas $item]
        if {$new != {}} {
            eval lappend new $items
            set items $new
        }
    }

    if $debug {
        puts ""
        puts "places:update A [::chrono::trigger]"
    }

    # Notify objects that they will be placed again.
    foreach callback $callbacks {
        eval $callback start
    }

    if $debug {
        puts "places:update B [::chrono::trigger]"
        places:update:debug $canvas "after callbacks start"
    }

    # Re-place the objects.
    if $debug {
        foreach cmd $commands {
            puts $cmd
            ::chrono::trigger
            eval $canvas $cmd
            puts [::chrono::trigger]
            #update
            #::chrono::sleep 1
        }
    } else {
        foreach cmd $commands {
            eval $canvas $cmd
        }
    }

    if $debug {
        puts "places:update C [::chrono::trigger]"
    }

    # Notify objects that they have been placed again.
    foreach callback $callbacks {
        eval $callback end
    }

    set lock [$canvas:vars:get places:update:lock]
    $canvas:vars:set places:update:lock [expr $lock - 1]

    if $debug {
        puts "places:update D [::chrono::trigger]"
    }
}

proc ::icanvas::places:update:debug {canvas {message ""}} {
    if ![$canvas:vars:get debug] return
    set width [$canvas:vars:get width]
    set height [$canvas:vars:get height]
    set aliens [$canvas find overlapping 0 0 $width $height]
    puts "ALIENS: $aliens"
    tk_messageBox -message $message
}

proc ::icanvas::configure:event {canvas} {
    set width [winfo width $canvas]
    set height [winfo height $canvas]
    if {$width == [$canvas:vars:get width] &&
        $height == [$canvas:vars:get height]} return
    $canvas:vars:set width $width
    $canvas:vars:set height $height
    grid:cells:configure:event $canvas
}


# Away placement.
proc ::icanvas::away {canvas tagOrId args} {
    move:away $canvas $tagOrId
}

# Anchor placement.
proc ::icanvas::anchor {canvas tagOrId args} {
    array set opts {
        -from "center"
        -to "center"
        -in ""
        -x 0
        -y 0
        -width ""
        -relwidth ""
        -height ""
        -relheight ""
        -align:min ""
        -expand:x 0
        -expand:y 0
        -debug 0
    }

    if ![exists $canvas $tagOrId] {
        return
    }

    foreach {opt val} $args {
        if {[array get opts $opt] == ""} {
            error "bad option $opt: should be one of [array names opts]"
        }
        set opts($opt) $val
    }

    if {$opts(-debug)} {
        ::chrono::trigger
    }

    if {$opts(-in) != "" &&
        ![exists $canvas $opts(-in)]} {
        puts "can't find -in item: anchor $canvas $tagOrId $args"
        return
    }

    if {$opts(-debug)} {
        puts "A. $canvas $tagOrId $args: [::chrono::trigger]s"
    }

    # Get the bounding box of the container.
    if {$opts(-in) == ""} {
        set bbox [canvas:coords:bbox $canvas]
    } else {
        set bbox [coords:bbox $canvas $opts(-in)]
    }
    set to [anchor:to:coords $opts(-to) $bbox]

    # Get the current size.
    set size [size $canvas $tagOrId]

    # Adjust size.
    if 1 {
        foreach dim {width height} old $size {
            set new $old

            if {$opts(-rel$dim) != ""} {
                set new [expr round($opts(-rel$dim) * ([bbox:$dim $bbox] + 1))]
                if {$opts(-$dim) != ""} {
                    set new [expr $new + $opts(-$dim)]
                }
            } else {
                if {$opts(-$dim) != ""} {
                    set new $opts(-$dim)
                }
            }

            set $dim $new
        }

        set size [list $width $height]
    }

    # Adjust size by alignment.
    if {$opts(-align:min) != ""} {
        set props [grid:properties $canvas $bbox $opts(-align:min)]
        foreach dim {width height} {cells cell:size} $props min $size {
            set quo [expr int(double($min) / ${cell:size})]
            set rem [expr $min - (${cell:size} * $quo)]
            set cells [expr {$rem > ${cell:size} / 2 ? ($quo + 1) : $quo}]
            if {$cells == 0} { incr cells }
            set $dim [expr $cells * ${cell:size}]
        }

        set size [list $width $height]
    }

    # Resize if necessary.
    eval size:set $canvas $tagOrId $size

    if {$opts(-debug)} {
        puts "size:set $canvas $tagOrId $size"
        puts "B. $canvas $tagOrId $args: [::chrono::trigger]s"
    }

    # Move the object.
    set ibbox [coords:bbox $canvas $tagOrId]
    set from [anchor:to:coords $opts(-from) $ibbox]

    foreach coord1 $from offset [list $opts(-x) $opts(-y)] coord2 $to {
        lappend move:x:y [expr $coord2 + $offset - $coord1]
    }

    # IDEA: would be nice if [small] moves were animated.

    if {$opts(-debug)} {
        puts [list $tagOrId $ibbox $from $to ${move:x:y}]
        puts "$canvas move $tagOrId ${move:x:y}"
    }

    eval move $canvas $tagOrId ${move:x:y}

    if {$opts(-debug)} {
        puts "  -> $tagOrId [coords:bbox $canvas $tagOrId]"
    }

    # Expand if requested.
    if {$opts(-expand:x) || $opts(-expand:y)} {
        expand $canvas $tagOrId $opts(-expand:x) $opts(-expand:y) $bbox
    }

    if {$opts(-debug)} {
        puts "  -> $tagOrId [coords:bbox $canvas $tagOrId]"
        puts "C. $canvas $tagOrId $args: [::chrono::trigger]s"
    }
}

proc ::icanvas::expand {canvas tagOrId expand:x expand:y in:bbox} {
    if {!${expand:x} && !${expand:y}} return

    set old:bbox [coords:bbox $canvas $tagOrId]
    if {${old:bbox} == {}} return

    lassign ${in:bbox} _x _y x_ y_

    lassign [size:get:min $canvas $tagOrId] w h
    lassign [anchor:to:coords center ${old:bbox}] x y
    set x1 [expr $x - ($w - 1) * 0.5]
    set y1 [expr $y - ($h - 1) * 0.5]
    set x2 [expr $x1 + $w - 1]
    set y2 [expr $y1 + $h - 1]

    #puts [list ${old:bbox} ${in:bbox} $x1 $y1 $x2 $y2]
    #if {$x1 < $_x || $y1 < $_y || $x2 > $x_ || $y2 > $y_} return

    set ids [find $canvas withtag $tagOrId]

    # Alternatives: the y axis could be tried first, or a different,
    # more general algorithm could be used.
    if ${expand:x} {
        # Left.
        foreach id [_$canvas find overlapping $_x $y1 $x1 $y2] {
            if {[lsearch $ids $id] != -1} continue
            set id:bbox [coords:bbox $canvas $id]
            set xx [lindex ${id:bbox} 2]
            if {$_x < $xx} { set _x [expr $xx + 1]}
        }

        set x1 $_x

        # Right.
        foreach id [_$canvas find overlapping $x2 $y1 $x_ $y2] {
            if {[lsearch $ids $id] != -1} continue
            set id:bbox [coords:bbox $canvas $id]
            set xx [lindex ${id:bbox} 0]
            if {$x_ > $xx} { set x_ [expr $xx - 1]}
        }

        set x2 $x_
    }

    if ${expand:y} {
        # Top.
        foreach id [_$canvas find overlapping $x1 $_y $x2 $y1] {
            if {[lsearch $ids $id] != -1} continue
            set id:bbox [coords:bbox $canvas $id]
            set yy [lindex ${id:bbox} 3]
            if {$_y < $yy} { set _y [expr $yy + 1]}
        }

        set y1 $_y

        # Bottom.
        foreach id [_$canvas find overlapping $x1 $y2 $x2 $y_] {
            if {[lsearch $ids $id] != -1} continue
            set id:bbox [coords:bbox $canvas $id]
            set yy [lindex ${id:bbox} 1]
            if {$y_ > $yy} { set y_ [expr $yy - 1]}
        }

        set y2 $y_
    }

    set new:bbox [list $x1 $y1 $x2 $y2]

    if {${old:bbox} != ${new:bbox}} {
        move:to $canvas $tagOrId $x1 $y1
        size:set $canvas $tagOrId [expr $x2 - $x1 + 1] [expr $y2 - $y1 + 1]
    }
}

proc ::icanvas::anchor:adjust {canvas tagOrId} {
    set bbox [coords:bbox $canvas $tagOrId]
    if {$bbox == ""} return
    lassign [anchor:to:coords center $bbox] x y

    set width [$canvas:vars:get width]
    if {$x < $width * 0.5} {
        set h w
        set xoff $x
    } else {
        set h e
        set xoff [expr $x - $width + 1]
    }

    set height [$canvas:vars:get height]
    if {$y < $height * 0.5} {
        set v n
        set yoff $y
    } else {
        set v s
        set yoff [expr $y - $height + 1]
    }

    # FIXME: caller should know that it uses place:set.
    place:set $canvas anchor $tagOrId \
        -from center -to $v$h \
        -x $xoff -y $yoff
}


# Grid placement.
proc ::icanvas::grid {canvas tagOrId args} {
    array set opts {
        -in ""
        -region ""
        -min:size ""
        -expand:x 0
        -expand:y 0
        -fit 0
        -pad 0
    }

    foreach {opt val} $args {
        if {[array get opts $opt] == ""} {
            error "bad option $opt: should be one of [array names opts]"
        }
        set opts($opt) $val
    }

    if {$opts(-region) == "" && $opts(-min:size) == ""} {
        set bbox [bbox $canvas $tagOrId]
        if {$bbox == ""} return
        set w [bbox:width $bbox]
        if $opts(-expand:x) { set w 1 }
        set h [bbox:height $bbox]
        if $opts(-expand:y) { set h 1 }
        set opts(-min:size) [list $w $h]
    }

    set coords [coords $canvas $tagOrId]
    if {$coords == ""} return

    if {$opts(-in) != ""} {
        lassign $opts(-min:size) w h
        move:away $canvas $tagOrId
        set region [grid:cells:find:free:region $canvas $w $h $opts(-in)]
        if {$region == {}} return
        set opts(-region) $region
    }

    set region $opts(-region)
    if {$region == ""} {
        lassign $opts(-min:size) w h
        move:away $canvas $tagOrId
        set region [grid:cells:find:free:region $canvas $w $h]
        if {$region == {}} {
            return
        }
    }

    set coords [grid:cells:region $canvas $region]

    if $opts(-expand:x) {
        set opts(-fit) 1
        lassign $coords x1 y1 x2 y2
        set minx [_$canvas canvasx 0]
        set maxx [_$canvas canvasx [expr [$canvas:vars:get width] - 1]]
        set left [_$canvas find overlapping $minx $y1 $x1 $y2]
        foreach id $left {
            lassign [bbox $canvas $id] x1_ y1_ x2_ y2_
            if {$x2_ > $minx} { set minx $x2_ }
        }
        set right [_$canvas find overlapping $x2 $y1 $maxx $y2]
        foreach id $right {
            lassign [bbox $canvas $id] x1_ y1_ x2_ y2_
            if {$x1_ < $maxx} { set maxx $x1_ }
        }

        set coords [list $minx $y1 $maxx $y2]
    }

    if $opts(-expand:y) {
        set opts(-fit) 1
        lassign $coords x1 y1 x2 y2
        set miny [_$canvas canvasy 0]
        set maxy [_$canvas canvasy [expr [$canvas:vars:get height] - 1]]
        set above [_$canvas find overlapping $x1 $miny $x2 $y1]
        foreach id $above {
            lassign [bbox $canvas $id] x1_ y1_ x2_ y2_
            if {$y2_ > $miny} { set miny $y2_ }
        }
        set below [_$canvas find overlapping $x1 $y2 $x2 $maxy]
        foreach id $below {
            lassign [bbox $canvas $id] x1_ y1_ x2_ y2_
            if {$y1_ < $maxy} { set maxy $y1_ }
        }

        set coords [list $x1 $miny $x2 $maxy]
    }

    set coords [bbox:pad $coords $opts(-pad)]

    set center [anchor:to:coords center $coords]
    lappend _args -to nw
    lappend _args -x [lindex $center 0]
    lappend _args -y [lindex $center 1]

    if $opts(-fit) {
        lappend _args -width [expr [bbox:width $coords] + 1]
        lappend _args -height [expr [bbox:height $coords] + 1]
    }

    eval anchor $canvas $tagOrId $_args
}


# Grid cells.

proc ::icanvas::grid:properties {canvas bbox size:min {pad:min ""}} {
    if {${pad:min} == ""} {
        foreach dim {width height} {
            set extent [expr double(round([bbox:$dim $bbox] + 1))]
            set quo [expr int($extent / ${size:min})]
            set rem [expr $extent - (${size:min} * $quo)]
            set pad [expr {$quo <= 0 ? 0 : $rem / $quo}]
            lappend result $quo [expr ${size:min} + $pad]
        }
    } else {
        set size [expr ${size:min} + ${pad:min}]
        foreach dim {width height} {
            set extent [expr double(round([bbox:$dim $bbox] + 1))]
            set quo [expr int(($extent - ${pad:min}) / $size)]
            set rem [expr $extent - (${size:min} * $quo)]
            set pad [expr $rem / ($quo + 1)]
            lappend result $quo ${size:min} $pad
        }
    }

    return $result
}

proc ::icanvas::grid:cells:region {canvas region {pad 0}} {
    set i [lindex $region 0]
    set j [lindex $region 1]
    set coords [grid:cell:coords $canvas $i $j]
    set i_ [lindex $region 2]
    set j_ [lindex $region 3]
    set coords_ [grid:cell:coords $canvas $i_ $j_]

    foreach idx {0 1} {
        lset coords $idx [expr [lindex $coords $idx] + $pad]
    }

    foreach idx {2 3} {
        lset coords $idx [expr [lindex $coords_ $idx] - $pad]
    }

    return $coords
}

proc ::icanvas::grid:cells:configure:event {canvas} {
    set width [$canvas:vars:get width]
    set height [$canvas:vars:get height]
    set bbox [canvas:coords:bbox $canvas]
    set size:min [$canvas:vars:get grid:cell:min:size]
    set properties [grid:properties $canvas $bbox ${size:min}]

    foreach dim {width height} {cells size} $properties {
        set $dim:cells $cells
        set $dim $size
    }

    $canvas:vars:set grid:cells [list ${width:cells} ${height:cells}]
    $canvas:vars:set grid:cell:size [list $width $height]
}

proc ::icanvas::grid:delete {canvas} {
    _$canvas delete grid:cells
    _$canvas delete grid:rulers
    _$canvas delete grid:text
}

proc ::icanvas::grid:draw {canvas} {
    grid:delete $canvas
    lassign [$canvas:vars:get grid:cells] m n

    set bg [_$canvas cget -background]
    set outline [::color::closer [::color::reverse $bg] $bg 0.9]

    #grid:cells:hilight:free $canvas
    #grid:cells:update:free $canvas

    if [$canvas:vars:get draw:grid:rulers] {
        _$canvas delete grid:rulers
        for {set i 1} {$i < $m} {incr i} {
            _$canvas create line [grid:vruler:coords $canvas $i] \
                -dash . -fill $outline -tags grid:rulers
        }
        for {set j 1} {$j < $n} {incr j} {
            _$canvas create line [grid:hruler:coords $canvas $j] \
                -dash . -fill $outline -tags grid:rulers
        }
        _$canvas lower grid:rulers
    }
}

proc ::icanvas::grid:cell:tag {i j} {
    return grid:cell:$i:$j
}

proc ::icanvas::grid:cell:coords {canvas i j} {
    lassign [$canvas:vars:get grid:cell:size] width height
    set x1 [expr $i * $width]
    set x2 [expr $x1 + $width - 1]
    set y1 [expr $j * $height]
    set y2 [expr $y1 + $height - 1]
    return [list $x1 $y1 $x2 $y2]
}

proc ::icanvas::grid:cell:overlapping {canvas x y} {
    lassign [$canvas:vars:get grid:cell:size] width height
    set i [expr int($x / $width)]
    set j [expr int($y / $height)]
    return [list $i $j]
}

proc ::icanvas::grid:vruler:coords {canvas i} {
    set width [lindex [$canvas:vars:get grid:cell:size] 0]
    set x [expr $i * $width]
    return [list $x 0 $x [$canvas:vars:get height]]
}

proc ::icanvas::grid:hruler:coords {canvas j} {
    set height [lindex [$canvas:vars:get grid:cell:size] 1]
    set y [expr $j * $height]
    return [list 0 $y [$canvas:vars:get width] $y]
}

proc ::icanvas::grid:cell:is:free {canvas i j {in ""}} {
    set maxIds 0
    set ignore [find $canvas withtag $in]
    set coords [grid:cell:coords $canvas $i $j]
    set ids [eval _$canvas find overlapping $coords]

    if {$ignore != {}} {
        foreach id $ids {
            if {[lsearch -exact $ignore $id] != -1} {
                incr maxIds
            }
        }
    }

#     foreach id $ids {
#         set tags [_$canvas gettags $id]
#         if {[lsearch -exact $tags grid:*] != -1} {
#             incr maxIds
#         }
#     }

    return [expr {[llength $ids] <= $maxIds}]
}

proc ::icanvas::grid:cells:is:free:region {canvas i_ j_ m_ n_ {in ""}} {
    lassign [$canvas:vars:get grid:cells] m n

    if {$i_ < 0} { return 0 }
    if {$j_ < 0} { return 0 }
    if {$i_ + $m_ > $m} { return 0 }
    if {$j_ + $n_ > $n} { return 0 }

    for {set j 0} {$j < $n_} {incr j} {
        for {set i 0} {$i < $m_} {incr i} {
            set free [grid:cell:is:free $canvas [expr $i_ + $i] [expr $j_ + $j] $in]
            if !$free { return 0 }
        }
    }

    return 1
}

proc ::icanvas::grid:cells:find:free:region {canvas minWidth minHeight {in ""}} {
    lassign {0 0} m1 n1
    lassign [$canvas:vars:get grid:cells] m2 n2
    lassign [$canvas:vars:get grid:cell:size] w h

    if {$in != ""} {
        lassign [coords:bbox $canvas $in] x1 y1 x2 y2
        if {$y2 == ""} { return {} }
        if {$x2 - $x1 < $minWidth} { return {} }
        if {$y2 - $y1 < $minHeight} { return {} }
        lassign [grid:cell:overlapping $canvas $x1 $y1] m1 n1
        lassign [grid:cell:overlapping $canvas $x2 $y2] m2 n2
        incr m2
        incr n2
    }

    set w_ 0
    set m_ 0
    while {$w_ <= $minWidth} {
        set w_ [expr $w_ + $w]
        incr m_
    }

    set h_ 0
    set n_ 0
    while {$h_ <= $minHeight} {
        set h_ [expr $h_ + $h]
        incr n_
    }

    # FIXME: quite inefficient.
    set found 0
    for {set j $n1} {$j < $n2} {incr j} {
        for {set i $m1} {$i < $m2} {incr i} {
            set found [grid:cells:is:free:region $canvas $i $j $m_ $n_ $in]
            if $found break
        }
        if $found break
    }

    if !$found { return {} }
    return [list $i $j [expr $i + $m_ - 1] [expr $j + $n_ - 1]]
}

proc ::icanvas::grid:cells:find:place {canvas tagOrId} {
    set bbox [bbox $canvas $tagOrId]
    if {$bbox == ""} { return {} }
    set w [bbox:width $bbox]
    set h [bbox:height $bbox]
    set region [grid:cells:find:free:region $canvas $w $h]
    return $region
}

proc ::icanvas::grid:cells:hilight:free {canvas} {
    lassign [$canvas:vars:get grid:cells] m n
    set bg [_$canvas cget -background]
    set outline [::color::closer [::color::reverse $bg] $bg 0.9]

    for {set j 0} {$j < $n} {incr j} {
        for {set i 0} {$i < $m} {incr i} {
            set tag [grid:cell:tag $i $j]
            set free [grid:cell:is:free $canvas $i $j]
            if $free {
                _$canvas itemconfigure $tag -fill ""
            } else {
                _$canvas itemconfigure $tag -fill $outline
            }
        }
    }
}

proc ::icanvas::grid:cells:update:free:backward:stop {canvas i1 j1} {
    set imin 0
    set jmin 0

    # Update west, same row.
    for {set i [expr $i1 - 1]} {$i >= $imin} {incr i -1} {
        set free [grid:cell:is:free $canvas $i $j1]
        if $free {
            set tag [grid:cell:tag $i $j1]
            set region [$canvas:free:regions:get $tag]
            $canvas:free:regions:set $tag \
                [list [expr min([lindex $region 0], $i1 - $i)] \
                     [lindex $region 1] \
                     [expr $i1 - $i] \
                     [lindex $region 3]]
         } else {
             set imin [expr $i + 1]
             break
        }
    }

    # Update north, same column.
    for {set j [expr $j1 - 1]} {$j >= $jmin} {incr j -1} {
        set free [grid:cell:is:free $canvas $i1 $j]
        if $free {
            set tag [grid:cell:tag $i1 $j]
            set region [$canvas:free:regions:get $tag]
            $canvas:free:regions:set $tag \
                [list [lindex $region 0] \
                     [expr $j1 - $j] \
                     [lindex $region 2] \
                     [expr $j1 - $j]]
        } else {
            set jmin [expr $j + 1]
            break
        }
    }

    # Update north-west.
    for {set i [expr $i1 - 1]} {$i >= $imin} {incr i -1} {
        for {set j [expr $j1 - 1]} {$j >= $jmin} {incr j -1} {
            set free [grid:cell:is:free $canvas $i $j]
            if $free {
                set tag [grid:cell:tag $i $j]
                set region [$canvas:free:regions:get $tag]
                $canvas:free:regions:set $tag \
                    [list [expr min([lindex $region 0], $i1 - $i)] \
                         [lindex $region 1] \
                         [lindex $region 2] \
                         [expr $j1 - $j]]
            } else {
                set jmin [expr $j + 1]
                break
            }
        }
    }
}

proc ::icanvas::grid:cells:update:free {canvas} {
    set grid:cell:min:size [$canvas:vars:get grid:cell:min:size]
    lassign [$canvas:vars:get grid:cells] m n

    # Compute freeness.
    for {set i 0} {$i < $m} {incr i} {
        for {set j 0} {$j < $n} {incr j} {
            set tag [grid:cell:tag $i $j]
            set free [grid:cell:is:free $canvas $i $j]
            if $free {
                $canvas:free:regions:set $tag \
                    [list [expr $m - $i] [expr $n - $j] \
                         [expr $m - $i] [expr $n - $j]]
            } else {
                $canvas:free:regions:set $tag [list 0 0 0 0]
                grid:cells:update:free:backward:stop $canvas $i $j
            }
        }
    }

    # Draw text.
    if [$canvas:vars:get draw:grid:text] {
        _$canvas delete grid:text
        for {set i 0} {$i < $m} {incr i} {
            for {set j 0} {$j < $n} {incr j} {
                set tag [grid:cell:tag $i $j]
                set region [$canvas:free:regions:get $tag]
                set id [_$canvas create text 0 0 -text $region \
                            -anchor n -font ::font::4 \
                            -tags grid:text -fill #55f]
                set coords [grid:cell:coords $canvas $i $j]
                anchor $canvas $id -from nw -to nw \
                    -x [expr [lindex $coords 0] + ${grid:cell:min:size} / 2] \
                    -y [expr [lindex $coords 1] + 2]
            }
        }
        _$canvas lower grid:text
    }
}


# Round rectangles.

proc ::icanvas::round:rectangle:tag {canvas id} {
    return "$canvas:rr:$id"
}

proc ::icanvas::round:rectangle:pattern {canvas} {
    return "$canvas:rr:%d"
}

proc ::icanvas::round:rectangle:create {canvas args} {
    set id [eval _$canvas create rectangle $args]
    set state [_$canvas itemcget $id -state]
    _$canvas itemconfigure $id -state hidden

    # Tag as a round rectangle.
    set tag [round:rectangle:tag $canvas $id]
    _$canvas addtag $tag withtag $id

    # Create images for the corners.
    foreach corner {nw ne se sw} {
        set img $tag:$corner
        image create photo $img
        set _id [_$canvas create image 0 0 \
                     -image $img \
                     -anchor $corner \
                     -tags $img \
                     -state $state]
        add:children $canvas $id $_id
    }

    # Draw the replacement.
    round:rectangle:draw $canvas $id

    return $id
}

proc ::icanvas::round:rectangle:draw {canvas id} {
    set tag [round:rectangle:tag $canvas $id]
    set state [_$canvas itemcget $tag:nw -state]
    if {$state == "hidden"} return

    #puts "DRAW $id"

    # Get attributes of temporary rectangle.
    lassign [_$canvas coords $id] x1 y1 x2 y2
    set owidth [_$canvas itemcget $id -width]
    set ioutline [_$canvas itemcget $id -outline]
    set ifill [_$canvas itemcget $id -fill]

    # Prepare outline width for magick.
    set howidth [expr ($owidth - 1) * 0.5]
    set minx [expr $x1 - $howidth]
    set miny [expr $y1 - $howidth]
    set maxx [expr $x2 + $howidth]
    set maxy [expr $y2 + $howidth]

    # Initialize magick pixels.
    set outline [magick create pixel]
    if {$ioutline == ""} {
        set ioutline_ "none"
    } else {
        set ioutline_ [::color::rgb $ioutline]
    }
    $outline SetColor $ioutline_

    set fill [magick create pixel]
    if {$ifill == ""} {
        set ifill_ "none"
    } else {
        set ifill_ [::color::rgb $ifill]
    }
    $fill SetColor $ifill_

    set transparent [magick create pixel]
    $transparent SetColor "none"

    # Initialize magick drawing.
    set mkDraw [magick create drawing]
    $mkDraw SetStrokeWidth $owidth
    $mkDraw SetStrokeColor $outline
    $mkDraw SetFillColor $fill

    set rx [expr min(10, ($maxx - $minx) / 2)]
    set ry [expr min(10, ($maxy - $miny) / 2)]
    set rmin [expr min($rx, $ry)]
    set rx $rmin
    set ry $rmin

    # Specify the rectangle.
    $mkDraw RoundRectangle \
        $howidth $howidth \
        [expr $maxx - $minx - $howidth] \
        [expr $maxy - $miny - $howidth] \
        $rx $ry

    ## For the whole rectangle.
    #set imgWidth [expr int($maxx - $minx + 1.5)]
    #set imgHeight [expr int($maxy - $miny + 1.5)]

    # Render just the NW corner.
    set imgWidth [expr round($rx + $owidth)]
    set imgHeight [expr round($ry + $owidth)]
    set mkImg(1) [magick create wand]
    $mkImg(1) size $imgWidth $imgHeight
    $mkImg(1) read "xc:none"
    $mkImg(1) draw $mkDraw

    # Other corners.
    set mkImg(2) [$mkImg(1) clone]
    $mkImg(2) rotate $transparent 90
    set mkImg(3) [$mkImg(1) clone]
    $mkImg(3) rotate $transparent 180
    set mkImg(4) [$mkImg(1) clone]
    $mkImg(4) rotate $transparent -90

    magick delete $mkDraw $outline $fill $transparent

#     # Debug.
#     _$canvas delete rrtest1:$id
#     _$canvas create rectangle $x1 $y1 $x2 $y2 \
#         -outline red -width $owidth -tags [list $tag rrtest1:$id]

    # Draw the body.
    set sides [list \
                     [expr $x1 + $rx] $y1 [expr $x2 - $rx] $y1 \
                     $x2 [expr $y1 + $ry] $x2 [expr $y2 - $ry] \
                     [expr $x2 - $rx] $y2 [expr $x1 + $rx] $y2 \
                     $x1 [expr $y2 - $ry] $x1 [expr $y1 + $ry]]

    set body [_$canvas find withtag $tag:body]
    set npolygons [expr {$ifill == ""} ? 4 : 1]

    if {[llength $body] != $npolygons} {
        _$canvas delete $tag:body

        if {$npolygons == 4} {
            # A flat polygon for each side.
            foreach _ {n e s w} {
                lappend body [_$canvas create polygon 0 0 0 0 \
                                  -fill $ifill -outline $ioutline -width $owidth \
                                  -state $state -tags $tag:body]
            }
        } else {
            # Just one polygon.
            lappend body [_$canvas create polygon 0 0 0 0 \
                              -fill $ifill -outline $ioutline -width $owidth \
                              -state $state -tags $tag:body]
        }

        set tags [_$canvas gettags $tag]
        foreach _tag $tags {
            _$canvas addtag $_tag withtag $tag:body
        }
    }

    eval add:children $canvas $id $body
    _$canvas lower $tag:body $tag

    if {$npolygons == 4} {
        # A flat polygon for each side.
        foreach {_x1 _y1 _x2 _y2} $sides polygon $body {
            _$canvas coords $polygon $_x1 $_y1 $_x2 $_y2
        }
    } else {
        # Just one polygon.
        foreach polygon $body {
            _$canvas coords $polygon $sides
        }
    }

    # Setup the corners.
    set offset [expr int($owidth * 0.5)]
    set odd [expr int($owidth) % 2]
    set _x1 [expr $x1 - $offset]
    set _y1 [expr $y1 - $offset]
    set _x2 [expr $x2 + $offset + $odd]
    set _y2 [expr $y2 + $offset + $odd]

    foreach {corner idx x y} [subst {
        nw 1 $_x1 $_y1
        ne 2 $_x2 $_y1
        se 3 $_x2 $_y2
        sw 4 $_x1 $_y2
    }] {
        set img $tag:$corner
        $img configure -width $imgWidth -height $imgHeight
        magicktophoto $mkImg($idx) $img
        _$canvas coords $img $x $y
        magick delete $mkImg($idx)
    }

#     # Debug.
#     _$canvas delete rrtest2:$id
#     _$canvas create rectangle $x1 $y1 $x2 $y2 \
#         -outline red -width $owidth -tags [list $tag rrtest2:$id]
}

proc ::icanvas::round:rectangle:id {canvas tagOrId} {
    set id [lindex [_$canvas find withtag $tagOrId] 0]
    set tags [_$canvas itemcget $id -tags]
    set pattern [round:rectangle:pattern $canvas]
    foreach tag $tags {
        if {[scan $tag $pattern id] == 1} {
            return $id
        }
    }
    return ""
}

proc ::icanvas::round:rectangle {canvas tagOrId} {
    set id [round:rectangle:id $canvas $tagOrId]
    if {$id == ""} { return "" }
    return [round:rectangle:tag $canvas $id]
}

proc ::icanvas::round:rectangle:test {canvas tagOrId} {
    return [expr {[round:rectangle:id $canvas $tagOrId] != ""}]
}

proc ::icanvas::round:rectangle:coords {canvas tagOrId args} {
    set id [round:rectangle:id $canvas $tagOrId]

    if {[llength $args] == 0} {
        return [_$canvas coords $id]
    }

    eval _$canvas coords $id $args
    round:rectangle:draw $canvas $id
}

proc ::icanvas::round:rectangle:itemcget {canvas tagOrId option} {
    set id [round:rectangle:id $canvas $tagOrId]
    if {$option == "-state"} {
        set tag [round:rectangle:tag $canvas $id]:nw
        return [_$canvas itemcget $tag -state]
    }
    return [_$canvas itemcget $id $option]
}

proc ::icanvas::round:rectangle:itemconfigure {canvas tagOrId args} {
    set id [round:rectangle:id $canvas $tagOrId]

    if {[llength $args] == 0} {
        set state [itemcget $canvas $id -state]
        _$canvas itemconfigure $id -state $state
        set result [_$canvas itemconfigure $id]
        _$canvas itemconfigure $id -state hidden
        return $result
    }

    set changed {}
    foreach {option value} $args {
        set old [round:rectangle:itemcget $canvas $id $option]
        if {$old == $value} continue
        lappend changed $option
    }

    if {[llength $changed] == 0} return

    eval _$canvas itemconfigure $id $args
    set state [_$canvas itemcget $id -state]

    foreach _id [find $canvas hierarchy $id] {
        _$canvas itemconfigure $_id -state $state
    }

    # Redraw the replacement.  Maybe not necessary for some options.
    round:rectangle:draw $canvas $id

    _$canvas itemconfigure $id -state hidden
}


# Misc.

proc ::icanvas::size {canvas tagOrId} {
    switch [_$canvas type $tagOrId] {
        window {
            set width [_$canvas itemcget $tagOrId -width]
            set height [_$canvas itemcget $tagOrId -height]
        }
        default {
            set bbox [coords:bbox $canvas $tagOrId]
            set width [expr [bbox:width $bbox] + 1]
            set height [expr [bbox:height $bbox] + 1]
        }
    }

    return [list $width $height]
}

proc ::icanvas::size:set {canvas tagOrId width height} {
    lassign [size $canvas $tagOrId] w h
    if {$w == $width && $h == $height} return

    switch [_$canvas type $tagOrId] {
        window {
            _$canvas itemconfigure $tagOrId -width $width
            _$canvas itemconfigure $tagOrId -height $height
        }
        default {
            set coords [coords $canvas $tagOrId]
            set ncoords [llength $coords]
            if {$ncoords == 2} return

            set x1 [lindex $coords 0]
            set y1 [lindex $coords 1]

            if {$ncoords == 4} {
                set _coords [list $x1 $y1 [expr $x1 + $width - 1] [expr $y1 + $height - 1]]
                coords $canvas $tagOrId $_coords
            } else {
                set cbbox [coords:bbox $canvas $tagOrId]
                foreach {dim new} [list width $width height $height] {
                    set old [expr [bbox:$dim $cbbox] + 1]
                    set $dim:factor [expr double($new) / $old]
                }

                lappend _coords $x1 $y1
                foreach {x y} [lrange $coords 2 end] {
                    lappend _coords [expr $x1 + ($x - $x1 + 1) * ${width:factor} - 1]
                    lappend _coords [expr $y1 + ($y - $y1 + 1) * ${height:factor} - 1]
                }

                coords $canvas $tagOrId $_coords
            }
        }
    }

    set callback [$canvas:size:set:callbacks:get $tagOrId]
    if {$callback != ""} {
        eval $callback $tagOrId $w $h $width $height
    }
}

proc ::icanvas::size:set:callback {canvas tagOrId callback args} {
    $canvas:size:set:callbacks:set $tagOrId [eval list $callback $args]
}

proc ::icanvas::size:set:min {canvas tagOrId width height} {
    $canvas:vars:set $tagOrId:size:min [list $width $height]
}

proc ::icanvas::size:get:min {canvas tagOrId} {
    set min:size [$canvas:vars:get $tagOrId:size:min]
    if {${min:size} == ""} {
        set min:size [size $canvas $tagOrId]
        eval size:set:min $canvas $tagOrId ${min:size}
    }
    return ${min:size}
}

proc ::icanvas::center {x1 x2} {
    return [expr ($x1 + $x2) * 0.5]
}

proc ::icanvas::anchor:to:coords {anchor bbox} {
    foreach {x1 y1 x2 y2} $bbox {
        switch $anchor {
            center { return [list [center $x1 $x2] [center $y1 $y2]] }
            nw { return [list $x1 $y1] }
            n  { return [list [center $x1 $x2] $y1] }
            ne { return [list $x2 $y1] }
            e  { return [list $x2 [center $y1 $y2]] }
            se { return [list $x2 $y2] }
            s  { return [list [center $x1 $x2] $y2] }
            sw { return [list $x1 $y2] }
            w  { return [list $x1 [center $y1 $y2]] }
        }
    }
}

proc ::icanvas::coords:bbox {canvas tagOrId} {
    set coords [coords $canvas $tagOrId]
    if {$coords == ""} { return "" }

    set x1 [lindex $coords 0]
    set y1 [lindex $coords 1]
    set x2 $x1
    set y2 $y1

    foreach {x y} $coords {
        if {$x < $x1} { set x1 $x }
        if {$x > $x2} { set x2 $x }
        if {$y < $y1} { set y1 $y }
        if {$y > $y2} { set y2 $y }
    }

    set bbox [list $x1 $y1 $x2 $y2]
    return $bbox
}

proc ::icanvas::canvas:coords:bbox {canvas} {
    set x1 [_$canvas canvasx 0]
    set y1 [_$canvas canvasy 0]
    set x2 [_$canvas canvasx [expr [$canvas:vars:get width] - 1]]
    set y2 [_$canvas canvasy [expr [$canvas:vars:get height] - 1]]
    return [list $x1 $y1 $x2 $y2]
}

proc ::icanvas::coords:bbox:all {canvas tagOrId} {
    set coords {}
    foreach id [_$canvas find withtag $tagOrId] {
        eval lappend coords [_$canvas coords $id]
    }

    if {$coords == ""} { return "" }
    set x1 [lindex $coords 0]
    set y1 [lindex $coords 1]
    set x2 $x1
    set y2 $y1

    foreach {x y} $coords {
        if {$x < $x1} { set x1 $x }
        if {$x > $x2} { set x2 $x }
        if {$y < $y1} { set y1 $y }
        if {$y > $y2} { set y2 $y }
    }

    set bbox [list $x1 $y1 $x2 $y2]
    return $bbox
}

proc ::icanvas::bbox:width {bbox} {
    set x1 [lindex $bbox 0]
    set x2 [lindex $bbox 2]
    return [expr abs($x2 - $x1)]
}

proc ::icanvas::bbox:height {bbox} {
    set y1 [lindex $bbox 1]
    set y2 [lindex $bbox 3]
    return [expr abs($y2 - $y1)]
}

proc ::icanvas::bbox:pad {bbox pad} {
    lassign $bbox x1 y1 x2 y2

    if {$x2 - $x1 > 2 * $pad} {
        set x1 [expr $x1 + $pad]
        set x2 [expr $x2 - $pad]
    }

    if {$y2 - $y1 > 2 * $pad} {
        set y1 [expr $y1 + $pad]
        set y2 [expr $y2 - $pad]
    }

    return [list $x1 $y1 $x2 $y2]
}

proc ::icanvas::move:to {canvas tagOrId x y} {
    set ids [find $canvas withtag $tagOrId]
    if {$ids == {}} return

    lassign [_$canvas coords [lindex $ids 0]] minx miny

    foreach id $ids {
        set coords [_$canvas coords $id]
        if {$coords == ""} continue
        lassign $coords x_ y_
        if {$x_ < $minx} { set minx $x_ }
        if {$y_ < $miny} { set miny $y_ }
    }

    move $canvas $tagOrId [expr $x - $minx] [expr $y - $miny]
}

proc ::icanvas::move:away {canvas tagOrId} {
    move:to $canvas $tagOrId \
        [expr 16 * [_$canvas canvasx [$canvas:vars:get width]]] \
        [expr 16 * [_$canvas canvasy [$canvas:vars:get height]]]
}

proc ::icanvas::scan:tags {canvas tagOrId format} {
    set ids [find $canvas withtag $tagOrId]
    foreach id $ids {
        set tags [_$canvas gettags $id]
        foreach tag $tags {
            set result [scan $tag "$format"]
            if {[lindex $result 0] == ""} continue
            if {[llength $result] == 1} {
                return [lindex $result 0]
            }
            return $result
        }
    }
    return ""
}

proc ::icanvas::top:id {canvas x y} {
    set ids [_$canvas find overlapping $x $y $x $y]
    set nids [llength $ids]
    for {set i [expr $nids - 1]} {$i >= 0} {incr i -1} {
        set top [lindex $ids $i]
        if {[lsearch [_$canvas gettags $top] "no:top"] == -1} {
            return $top
        }
    }
    return ""
}

proc ::icanvas::exists {canvas tagOrId} {
    set ids [_$canvas find withtag $tagOrId]
    if {$ids != {}} { return 1 }
    set children [children $canvas $tagOrId]
    if {$children != {}} { return 1 }
    return 0
}

proc ::icanvas::addtags {canvas tagOrId args} {
    foreach id [_$canvas find withtag $tagOrId] {
        foreach tag $args {
            _$canvas addtag $tag withtag $id
        }
    }
}

proc ::icanvas::is:visible {canvas tagOrId} {
    lassign [canvas:coords:bbox $canvas] x1 y1 x2 y2
    set ids [find $canvas withtag $tagOrId]
    foreach id $ids {
        set coords [_$canvas coords $id]
        if {$coords == ""} continue
        lassign $coords x_ y_
        if {$x_ >= $x1 &&
            $x_ <= $x2 &&
            $y_ >= $y1 &&
            $y_ <= $y2} {
            return 1
        }
    }
    return 0
}

proc ::icanvas::relative:coords {canvas tagOrIdOrCoords1 tagOrIdOrCoords2} {
    set coords_ {}

    if {[llength $tagOrIdOrCoords2] >= 2} {

        lassign [coords:bbox $canvas $tagOrIdOrCoords1] x1 y1
        foreach {x y} $tagOrIdOrCoords2 {
            lappend coords_ [expr $x + $x1] [expr $y + $y1]
        }

    } else {
        if {[llength $tagOrIdOrCoords1] >= 2} {
            set coords $tagOrIdOrCoords1
        } else {
            set coords [_$canvas coords $tagOrIdOrCoords1]
        }

        lassign [coords:bbox $canvas $tagOrIdOrCoords2] x1 y1
        foreach {x y} $coords {
            lappend coords_ [expr $x - $x1] [expr $y - $y1]
        }
    }

    return $coords_
}

proc ::icanvas::confirm {canvas title message} {
    set confirm [tk_messageBox -type okcancel -title $title -message $message]
    focus $canvas
    return $confirm
}

