# fly.tcl - Animated toplevel.
# Writted by Rejjin 
# xmpp: 	<rejjin@jabber.ru>
# e-mail:	<webrenji@gmail.com>

namespace eval ::fly {
variable fly_options 

	array set fly_options {
		-anchor se
		-animate up
		-offsetx 0
		-offsety 0
		-keyframes {1000 3000 500}
		-animation 5
		-withdraw 1
		-manual 0
	}

	package provide fly 0.1
	
	namespace export hide show state animate init
}

proc ::fly::init {top args} {
variable fly_options

	if {![winfo exist $top]} {
	return -code error "bad window path name \"$top\""
	}
	
	foreach option [array names fly_options -*] {
	set t_options($option) $fly_options($option)
	}
	
	foreach {option value} $args {
		switch -- $option {
		-anchor {set t_options(-anchor) $value}
		-animate {set t_options(-animate) $value}
		-offsetx {set t_options(-offsetx) $value}
		-offsety {set t_options(-offsety) $value}
		-keyframes {set t_options(-keyframes) $value}
		-animation {set t_options(-animation) $value}
		-withdraw {set t_options(-withdraw) $value}
		-manual {set t_options(-manual) $value}
		default {return -code error "bad option name $option"}
		}
	}
	
	set varname [namespace current]::fly_$top
	namespace upvar [namespace current] $varname _fly

	set _fly(top) $top
	set _fly(state) 0
	set _fly(timer) {}
	
	foreach option [array names t_options] {
	set _fly($option) $t_options($option)
	}
	
	if {[string is true $_fly(-withdraw)]} {
	wm withdraw $top
	}
	
	return $top
}

proc ::fly::hide {top {atonce 0}} {
	set varname [namespace current]::fly_$top
	namespace upvar [namespace current] $varname _fly
	
	if {![string equal $_fly(timer) {}]} {
	    after cancel $_fly(timer)
	    set _fly(timer) {}
	}
	
	if {[string is true $atonce]} {
		set _fly(state) 0
	    if {[string is true $_fly(-withdraw)]} {
		wm withdraw $_fly(top)
	    } else {init_position $top}
	} elseif {$_fly(state) != 0} {
		set _fly(state) 1
	    set _fly(startanim) [clock clicks -milliseconds]
	    animate $top 0 
	}
}

proc ::fly::show {top} {
	set varname [namespace current]::fly_$top
	namespace upvar [namespace current] $varname _fly
	
	if {$_fly(state) != 0} {hide $top 1}
	
	if {[string is true $_fly(-manual)]} {
	animate $top 1
	} else {animate $top}
}

proc ::fly::validate {top} {
	set varname [namespace current]::fly_$top
	namespace upvar [namespace current] $varname _fly
	
	set anchor [string tolower $_fly(-anchor)]
	
	foreach {an pos} {n down e left s up w right} {
		if {[string first $an $anchor]} {
		lappend valid $pos
		}
	}
	
	set animate [string tolower $_fly(-animate)]
	
	if {[lsearch $animate $valid] >= 0} {
	return 1
	}
	
	return 0
}

proc ::fly::state {top} {
	set varname [namespace current]::fly_$top
	namespace upvar [namespace current] $varname _fly
	
	return $_fly(state)
}


proc ::fly::init_position {top} {
	set varname [namespace current]::fly_$top
	namespace upvar [namespace current] $varname _fly
	
	if {[validate $top]} {
	    set _fly(timer) {}
		return -code error "$_fly(-anchor) and \
			$_fly(-animate) are incompatible"
	}
	
	set sw [winfo screenwidth $top]
	set sh [winfo screenheight $top]
	
	set csx [expr {$sw / 2}] 
	set csy [expr {$sh / 2}]
	
	set w [winfo width $top]
	set h [winfo height $top]
	
	set cx [expr {$w / 2}]
	set cy [expr {$h / 2}]
	
	switch [string tolower $_fly(-anchor)] {
	    n {
			set _fly(startx) [expr $csx - $cx + $_fly(-offsetx)]
			set _fly(starty) [expr -$h + $_fly(-offsety)]
			set _fly(endx) $_fly(startx)
			set _fly(endy) $_fly(-offsety)
	    }
	    ne {
			if {[string equal [string tolower $_fly(-animate)] down]} {
				set _fly(startx) [expr $sw - $w + $_fly(-offsetx)]
				set _fly(starty) [expr -$h + $_fly(-offsety)]
				set _fly(endx) $_fly(startx)
				set _fly(endy) $_fly(-offsety)
			} else {
				set _fly(startx) [expr $sw + $_fly(-offsetx)]
				set _fly(starty) [expr $_fly(-offsety)]
				set _fly(endx) [expr $sw - $w + $_fly(-offsetx)]
				set _fly(endy) $_fly(starty)
			}
	    }
	    e {
			set _fly(startx) [expr $sw + $_fly(-offsetx)]
			set _fly(starty) [expr $csy - $cy + $_fly(-offsety)]
			set _fly(endx) [expr $sw - $w + $_fly(-offsetx)]
			set _fly(endy) $_fly(starty)
	    }
	    se {
			if {[string equal [string tolower $_fly(-animate)] left]} {
				set _fly(startx) [expr $sw + $_fly(-offsetx)]
				set _fly(starty) [expr $sh - $h + $_fly(-offsety)]
				set _fly(endx) [expr $sw - $w + $_fly(-offsetx)]
				set _fly(endy) $_fly(starty)
			} else {
				set _fly(startx) [expr $sw - $w + $_fly(-offsetx)]
				set _fly(starty) [expr $sh + $_fly(-offsety)]
				set _fly(endx) $_fly(startx)
				set _fly(endy) [expr $sh - $h + $_fly(-offsety)]
			}
	    }
	    s {
			set _fly(startx) [expr $csx - $cx + $_fly(-offsetx)]
			set _fly(starty) [expr $sh + $_fly(-offsety)]
			set _fly(endx) $_fly(startx)
			set _fly(endy) [expr $sh - $h + $_fly(-offsety)]
	    }
	    sw {
			if {[string equal [string tolower $_fly(-animate)] up]} {
				set _fly(startx) [expr $_fly(-offsetx)]
				set _fly(starty) [expr $sh + $_fly(-offsety)]
				set _fly(endx) $_fly(startx)
				set _fly(endy) [expr $sh - $h + $_fly(-offsety)]
			} else {
				set _fly(startx) [expr -$w + $_fly(-offsetx)]
				set _fly(starty) [expr $sh - $cy + $_fly(-offsety)]
				set _fly(endx) $_fly(-offsetx)
				set _fly(endy) $_fly(starty)
			}
	    }
	    w {
			set _fly(startx) [expr -$w + $_fly(-offsetx)]
			set _fly(starty) [expr $csy - $cy + $_fly(-offsety)]
			set _fly(endx) $_fly(-offsetx)
			set _fly(endy) $_fly(starty)
	    }
	    nw {
			if {[string equal [string tolower $_fly(-animate)] right]} {
				set _fly(startx) [expr -$w + $_fly(-offsetx)]
				set _fly(starty) [expr $_fly(-offsety)]
				set _fly(endx) $_fly(-offsetx)
				set _fly(endy) $_fly(starty)
			} else {
				set _fly(startx) [expr $_fly(-offsetx)]
				set _fly(starty) [expr -$h + $_fly(-offsety)]
				set _fly(endx) $_fly(startx)
				set _fly(endy) $_fly(-offsety)
			}
	    }
	}
	
	wm deiconify $_fly(top)
	wm geometry $_fly(top) +$_fly(startx)+$_fly(starty)

	update idletasks
}

proc ::fly::animate {top {stopat ""}} {
	set varname [namespace current]::fly_$top
	namespace upvar [namespace current] $varname _fly
	
	if {[validate $top]} {
	    set _fly(timer) {}
		return -code error "$_fly(-anchor) and \
			$_fly(-animate) are incompatible"
	}
	
	switch $_fly(state) {
	    0 {
			wm deiconify $top
			update idletasks
			init_position $top
			set _fly(startanim) [clock clicks -milliseconds]
			set _fly(state) 2
	    }
	    2 {
			set now [clock clicks -milliseconds]
			set elapsed [expr {$now - $_fly(startanim)}]
			set sp [lindex $_fly(-keyframes) 0]
			
			if { $elapsed >= $sp } {
				set x $_fly(endx)
				set y $_fly(endy)
				set _fly(startanim) $now
				set _fly(state) 1
			} else {
				set x [expr {int($elapsed * (double($_fly(endx) - $_fly(startx))/$sp)) + $_fly(startx)}]
				set y [expr {int($elapsed * (double($_fly(endy) - $_fly(starty))/$sp)) + $_fly(starty)}]
			}
			
			wm deiconify $_fly(top)
			wm geometry $_fly(top) +$x+$y
	    }
	    1 {
			set now [clock clicks -milliseconds]
			set elapsed [expr {$now - $_fly(startanim)}]
			set sp [lindex $_fly(-keyframes) 1]
			if {[string equal $sp ""]} { 
				set sp [lindex $_fly(-keyframes) 0] 
			}
			if { $elapsed >= $sp } {
				set _fly(startanim) $now
				set _fly(state) 3
			}
			set x $_fly(endx)
			set y $_fly(endy)
			wm deiconify $_fly(top)
			wm geometry $_fly(top) +$x+$y
	    }
	    3 {
			set now [clock clicks -milliseconds]
			set elapsed [expr {$now - $_fly(startanim)}]
			set sp [lindex $_fly(-keyframes) 2]
			if {[string equal $sp ""]} { 
				set sp [lindex $_fly(-keyframes) 1] 
			}
			if {[string equal $sp ""]} {
				set sp [lindex $_fly(-keyframes) 0] 
			}
			if { $elapsed >= $sp } {
				if { [string is true $_fly(-withdraw)] } {
					wm withdraw $_fly(top)
				}
				set _fly(state) 0
			} else {
				set x [expr {int($elapsed * (double($_fly(startx) - $_fly(endx))/$sp)) + $_fly(endx)}]
				set y [expr {int($elapsed * (double($_fly(starty) - $_fly(endy))/$sp)) + $_fly(endy)}]
				wm deiconify $_fly(top)
				wm geometry $_fly(top) +$x+$y
			}
	    }
	}

	if { $_fly(state) == 0 } {
	set _fly(timer) {}
	} else {
	    if {$_fly(state) == $stopat} {
			set _fly(timer) {}
	    } else {
			set _fly(timer) [after $_fly(-animation) [namespace current]::animate $top $stopat]
	    }
	}
}