# scalingcanvas.tcl --
#     Example of scaling and scrolling a canvas
#

#
# Set up the canvas with scrollbars
#

canvas .c -bg white -xscrollcommand {.x set} -yscrollcommand {.y set}
scrollbar .x -orient horizontal -command {.c xview}
scrollbar .y -orient vertical   -command {.c yview}

grid .c .y -sticky news
grid .x    -sticky news

grid columnconfigure . 0 -weight 1
grid rowconfigure    . 0 -weight 1

#
# Fill the canvas with a few items
#
.c create oval      100 100 200 200 -fill red -outline black -width 2
.c create rectangle 150  50 175 275 -outline green -width 4
.c create rectangle   0   0   2   2 -fill black ;# Origin
.c create rectangle 148 148 152 152 -fill black ;# Centre circle

#
# Set up a default scroll region
#
.c configure -scrollregion [list 0 0 [.c cget -width] [.c cget -height]]

#
# Now we will zoom in to the circle's centre (150,150) and make sure this
# is in the middle of the canvas
#
# 1. Scale all items by a factor of two
# 2. Adjust the scroll region accordingly
# 3. Scroll the canvas to the right position
#
# canvas           - canvas in question
# xcentre, ycentre - coordinates for the centre of the scaling
# factor           - factor by which to scroll
#
proc scaleAndScroll {canvas xcentre ycentre factor} {

    $canvas scale all $xcentre $ycentre $factor $factor
    set scrollRegion [$canvas cget -scrollregion]

    set newRegion {}
    lassign $scrollRegion xmin ymin xmax ymax

    set xmin [expr {$xcentre + ($xmin - $xcentre) * $factor}]
    set ymin [expr {$ycentre + ($ymin - $ycentre) * $factor}]
    set xmax [expr {$xcentre + ($xmax - $xcentre) * $factor}]
    set xmax [expr {$xcentre + ($ymax - $xcentre) * $factor}]

    $canvas configure -scrollregion [list $xmin $ymin $xmax $ymax]
}

#
# canvas           - canvas in question
# xcoord, ycoord   - coordinates for the centre of the scaling
#
proc toCentre {canvas xcoord ycoord} {

    lassign [$canvas cget -scrollregion] xmin ymin xmax ymax

    #
    # Compute the fraction:
    # "$xcoord - 0.5 * $width" is the x-coordinate of the point
    # that will appear at the top-left corner
    #
    set width  [$canvas cget -width]
    set height [$canvas cget -height]
    set xfrac [expr {($xcoord - 0.5 * $width  - $xmin) / ($xmax - $xmin)}]
    set yfrac [expr {($ycoord - 0.5 * $height - $ymin) / ($ymax - $ymin)}]

    $canvas xview moveto $xfrac
    $canvas yview moveto $yfrac
}

scaleAndScroll .c 150 150 2.0

# Show new origin
.c create rectangle 0 0 2 2 -fill blue -outline blue

after 2000 {
   toCentre .c 150 150
}