# 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/>.
#----------------------------------------------------------------------

package provide chrono 1.0
package require Tcl 8.5

# Various procedures to manage time.  Time is represented as floating
# point values in seconds.

namespace eval ::chrono {
    variable triggers
    variable sleep:vars
    variable sleep:vars:counter
}

# Returns the current time.
proc ::chrono::now {} {
    return [expr 0.001 * [clock milliseconds]]
}

# Returns the time spent in the caller since the previous call.
proc ::chrono::trigger {} {
    variable triggers
    set key [key_private]
    set then [lindex [array get triggers $key] 1]
    set now [now]
    if {$then == ""} { set then $now }
    set triggers($key) $now
    return [expr $now - $then]
}

# Makes the caller wait (using vwait) for the given amount of time.
proc ::chrono::sleep {{seconds 0.001}} {
    set key [incr ::chrono:sleep:vars:counter]
    set ::chrono::sleep:vars($key) $seconds
    after [expr int($seconds * 1000)] \
        "set ::chrono::sleep:vars($key) 0"
    vwait ::chrono::sleep:vars($key)
}

# Used internally to identify caller.
proc ::chrono::key_private {} {
    set dict [info frame -3]
    if [dict exists $dict proc] {
        set key [dict get $dict proc]
    } else {
        set key [dict get $dict cmd]
    }
    return $key
}

