Initial commit

package.lisp

@@ -0,0 +1,5 @@
+;;;; package.lisp
+
+(defpackage #:timedset
+  (:use #:cl
+	#:flan-utils))

timedset.asd

@@ -0,0 +1,11 @@
+;;;; timedset.asd
+
+(asdf:defsystem #:timedset
+  :description "Timed running"
+  :author "Rin <flanchan@cumallover.me>"
+  :license  "Public domain"
+  :version "0.0.1"
+  :serial t
+  :depends-on ( #:flan-utils )
+  :components ((:file "package")
+               (:file "timedset")))

timedset.lisp

@@ -0,0 +1,81 @@
+;;;; 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)