# repackanim.tcl ---
#
#       An utility to achive sliding toplevel height while swapping two
#       notebook pages.
#       
#  Usage: 
#       ::repackanim::swap frame1 frame2 ?-command tclProc -text str -widget key?
#       -widget typically "ttk::label %s -text Wait..."
#       
#  Copyright (c) 2007 Mats Bengtsson
#  
#  This source file is distributed under the BSD license.
#  
#  $Id: repackanim.tcl,v 1.3 2007-12-22 14:52:22 matben Exp $

package provide repackanim 0.1

namespace eval ::repackanim {
   
    variable options
    array set options {
	step   4
	millis 40
    }
}

proc ::repackanim::configure {args} {
    variable options
    
    array set options $args
}

proc ::repackanim::swap {wfrom wto args} {
    variable options
    
    set w [winfo toplevel $wfrom]
    if {$w ne [winfo toplevel $wto]} {
	puts stderr "Both widgets must belong to the same toplevel"
    }
    variable $w
    upvar 0 $w state

    array set opts {
	-command {}
	-text    "Loading page..."
	-widget  ""
    }
    array set opts $args
    set state(opts) [array get opts]
    set state(w)     $w
    set state(wfrom) $wfrom
    set state(wto)   $wto

    # Do this in order to get correct sizes.
    update idletasks
    set h1 [winfo reqheight $wfrom]
    set h2 [winfo reqheight $wto]
    set delta [expr {$h2 - $h1}]
    puts "::repackanim::repack h1=$h1, h2=$h2"

    wm positionfrom $w user

    set tmp ${wfrom}_tmp
    ttk::frame $tmp
    if {[string length $opts(-widget)]} {
	eval [format $opts(-widget) $tmp.label]
    } else {
	ttk::label $tmp.label -text $opts(-text)
    }
    place $tmp.label -x [expr {[winfo width $wfrom]/2}] -y [expr {$h1/2}] -anchor c
    
    pack forget $wfrom
    pack $tmp -fill both -expand 1
    
    set state(height) [expr {[winfo height $w] + $delta}]
    Animate $w
}

proc ::repackanim::Animate {w} {
    variable options
    variable $w
    upvar 0 $w state

    if {![winfo exists $w]} {
	unset -nocomplain state
    }
    set height $state(height)
    set geom [split [wm geometry $w] x+-]
    set h [lindex $geom 1]
    set sign [expr {$h < $height ? "+" : "-"}]
    if {$h == $height} {
	Final $w
	return
    }
    set step $options(step)
    #pack propagate $w 0
    if {$sign eq "+"} {
	set new [expr {$h + $step}]
	if {$new > $height} {
	    set h $height
	} else {
	    incr h $sign$step
	}
    } else {
	set new [expr {$h - $step}]
	if {$new < $height} {
	    set h $height
	} else {
	    incr h $sign$step
	}
    }
    wm geometry $w [lindex $geom 0]x$h
    after $options(millis) [namespace code [list Animate $w]]
}

proc ::repackanim::Final {w} {
    variable $w
    upvar 0 $w state

    puts "::repack::Final"
    if {![winfo exists $w]} {
	unset -nocomplain state
    }
    #pack propagate $w 1
    destroy $state(wfrom)_tmp
    pack $state(wto)
    array set opts $state(opts)
    if {[llength $opts(-command)]} {
	uplevel #0 $opts(-command)
    }
    unset -nocomplain state    
}

# Test code.
if {0} {    
    proc content {w n} {
	ttk::frame $w -padding 20
	for {set i 0} {$i < $n} {incr i} {
	    ttk::label $w.$i -text "Some junk number $i"
	    grid $w.$i -sticky w
	}
	return $w
    }

    set w .top
    toplevel $w
    set f1 [content $w.f1 10]
    set f2 [content $w.f2 20]
    pack $f1
    after 4000 [list ::repackanim::swap $f1 $f2]
}

