# ACTIVESTATE TEAPOT-PKG BEGIN TM -*- tcl -*-
# -- Tcl Module

# @@ Meta Begin
# Package debug::heartbeat 1
# Meta as::build::date 2015-05-25
# Meta as::origin      http://sourceforge.net/projects/tcllib
# Meta category        debug narrative
# Meta description     debug narrative - heartbeat
# Meta license         BSD
# Meta platform        tcl
# Meta require         {Tcl 8.5}
# Meta require         debug
# Meta subject         narrative heartbeat log trace debug
# Meta summary         debug::heartbeat
# @@ Meta End


# ACTIVESTATE TEAPOT-PKG BEGIN REQUIREMENTS

package require Tcl 8.5
package require debug

# ACTIVESTATE TEAPOT-PKG END REQUIREMENTS

# ACTIVESTATE TEAPOT-PKG BEGIN DECLARE

package provide debug::heartbeat 1

# ACTIVESTATE TEAPOT-PKG END DECLARE
# ACTIVESTATE TEAPOT-PKG END TM
# -*- tcl -*
# Debug -- Heartbeat. Track operation of Tcl's eventloop.
# -- Colin McCormack / originally Wub server utilities

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require debug

namespace eval ::debug {
    namespace export heartbeat
    namespace ensemble create
}

# # ## ### ##### ######## ############# #####################
## API & Implementation

proc ::debug::heartbeat {{delta 500}} {
    variable duration $delta
    variable timer

    if {$duration > 0} {
	# stop a previous heartbeat before starting the next
	catch { after cancel $timer }
	on heartbeat
	every $duration {
	    debug.heartbeat {[debug::pulse]}
	}
    } else {
	catch { after cancel $timer }
	off heartbeat
    }
}

proc ::debug::every {ms body} {
    eval $body
    variable timer [after $ms [info level 0]]
    return
}

proc ::debug::pulse {} {
    variable duration
    variable hbtimer
    variable heartbeat

    set now  [::tcl::clock::milliseconds]
    set diff [expr {$now - $hbtimer - $duration}]

    set hbtimer $now

    return [list [incr heartbeat] $diff]
}

# # ## ### ##### ######## ############# #####################

namespace eval ::debug {
    variable duration  0 ; # milliseconds between heart-beats
    variable heartbeat 0 ; # beat counter
    variable hbtimer   [::tcl::clock::milliseconds]
    variable timer
}

# # ## ### ##### ######## ############# #####################
## Ready

package provide debug::heartbeat 1
return