;;;; timedset.lisp

(in-package #:timedset)

(enable-all-readers)

[ ;; exports

(defparameter *active-timers* nil)
(defparameter *lock* (bt:make-lock))

(defun at (itsu nani &optional motto)
  "Run a function at specified universal-time"
  (bt:with-lock-held (*lock*)
    (let* ((start-time (get-universal-time))
	   (wait-time (- itsu start-time))
	   (uid (gensym)))
      (if (< wait-time 0) nil
      (car (push $(yield-return 
		   (push-handler 'time-elapsed
				 £(- (get-universal-time) start-time))
		   (push-handler 'uid
				 £uid)
		   (push-handler 'data
				 £motto)
		   (sleep wait-time)
		   (yield (handler-case (values (funcall nani) nil)
			    (error (x) 
				   (values nil x))))
		   (bt:with-lock-held (*lock*)
		     (setf *active-timers*
			   (where 
			     #'(lambda (timer)
				 ¬(eql uid (funcall (async-info-handler timer 'uid))))
			     *active-timers*))))
		 *active-timers*))))))

(defun elapsed (handle)
  "Time (seconds) since timer was set"
  (funcall (async-info-handler handle 'time-elapsed)))

(defun id (handle)
  (funcall (async-info-handler handle 'uid)))

(defun data (handle)
  (funcall (async-info-handler handle 'data)))

(defun current-active-timers ()
  "Get current active timers"
  (bt:with-lock-held (*lock*)
    (copy-list *active-timers*)))

(defun wait-all (&optional timeout)
  "Wait for all timers, optionally on timeout"
  (let ((waiter 
	  $(let ((actives nil))
	     (bt:with-lock-held (*lock*)
	       (setf actives (copy-list *active-timers*)))
	     (mapc #'(lambda (x)
		       (wait x))
		   actives))))
    (if timeout
      (progn
	(sleep timeout)
	(when (aync-alive waiter)
	  (async-kill waiter)
	  nil)
	t)
      (progn 
	(wait waiter)
	t))))

(defun stop-all ()
  "Kill all timer threads"
  (bt:with-lock-held (*lock*)
    (mapc #'async-kill *active-timers*)
    (setf *active-timers* nil)))

] ;; end exports

(disable-all-readers)