(require (lib "rsc.ss" "rsc")
	 (lib "1.ss" "srfi"))

(define Q (make-schedule*))

(define (print . l)
  (for-each display l)
  (newline))

(at
 Q 
 (+ (utc) 1) 
 (lambda (t f) 
   (print "time = " t)
   void))

(let* ((T (ceiling (utc)))
       (P (lambda (n) (lambda (t f) (print "Test " (- t T) " " n)))))
  (at Q (+ T 2) (P 1))	; Empty special case.
  (at Q (+ T 4) (P 2))	; At end special case.
  (at Q (+ T 1) (P 3))	; At front special case.
  (at Q (+ T 2) (P 4))	; At same time special case.
  (at Q (+ T 3) (P 5)))	; `Ordinary' case.

(schedule-clear Q)

(at
 Q
 (ceiling (utc)) 
 (lambda (t f)
   (print "The time is " t) 
   (if (> (rand! 0.0 1.0) 0.1) 
       (f 0.5)
       (print "End of sequence"))))

;; If a procedure at the schedule throws an error this is handled
;; gracefully, ie. the schedule is still operational and there is an
;; error printed to the error port.

(at
 Q
 (ceiling (utc))
 (lambda (t f) 
   (print "The time is" t) 
   (if (> (rand! 0.0 1.0) 0.9) (error "An error in a scheduled procedure"))
   (if (> (rand! 0.0 1.0) 0.1) (f 0.5) (print "End of sequence"))))

(begin 
  (for-each (lambda (n)
	      (at
	       Q
	       (+ n 1 (utc))
	       (lambda (t f) (print "I am going nowhere :(" t))))
	    (iota 5))
  (schedule-clear Q))

;; Demonstrate that the time reported to the scheduled procedure is
;; the time it was scheduled for, not the current time.  

(define (busy-loop)
  (let loop ((n 0))
    (if (< n 4e6)
	(loop (+ n 1)))))

(at
 Q
 (+ (utc) 1.0) 
 (lambda (t f)
   (busy-loop)
   (print "e " t " " (utc))
   (f 0.1)))

;; The above does not clear properly because it is almost never *in*
;; the queue - it is busy waiting and then is straight in and out.

(schedule-clear Q)

;; However we can kill the whole schedule.

(schedule-terminate Q)