[Chicken-users] scheduler

[F. Wittenberger]

#!/usr/bin/csi -s

;; Please try:

;; This is a multi player scene.  Hence we
(  require-extension
;; 
   srfi-18
;; [and
   posix
;; for i/o].
)

(let ((title "On The Sinking Ship"))
  ;; let['s]rec[call] some common sense
  (letrec ((chop-head (lambda () (exit 1)))
           (definately (lambda (write text)
                         (write text (current-error-port))))
           (for-ever (lambda (do something)
                       (do something)
                       (for-ever do something)))
           (leave (lambda () (exit 0)))
           (one-hundred-times (lambda (write text)
                                (do ((count 0 (+ count 1)))
                                    ((eqv? count 100) #t)
                                  (write text)
                                  (write #\newline))))
           (sing (lambda (song)
                   (do ((i 0 (+ 1 i)))
                       ((= i (vector-length song)))
                     (display (vector-ref song i))
                     (newline)
                     (thread-sleep! 0.5))))
           (take-punishment (lambda (sentence)
                              (and (one-hundred-times
                                    (lambda (this)
                                      (definately display this)
                                      (definately display #\newline))
                                    sentence)
                                   (chop-head)))))
    ;; now the play:
    (print "Open Stage")
    (let* ((old-song '#("We shall overco.ome"
                        "we shall overco.ome"
                        "we shall overcome"
                        "some dayayayay"))
           (union (make-thread
                   (lambda ()
                     (handle-exceptions
                      ups
                      (begin
                        (display "We are afraid, we can't help you anymore.
Thanks for paying your membership fee.
"
                                 (current-error-port))
                        (leave))
                      (for-ever sing old-song)))))
           (boss (make-thread
                  (lambda ()
                    (thread-sleep! 1.5)
                    (file-close 1)
                    (display "Shut up!\n")
                    (thread-sleep! 1.5)
                    (leave))))
           (regie (make-mutex 'seat)))
      (mutex-lock! regie)
      (print "The unions enters the scene.")
      (thread-start! union)
      (print "Note: the boss's window is open!")
      (thread-start! boss)
      (print "Now let's watch what happens.")
      (mutex-lock! regie)
      (take-punishment "We better dealt with bad file descriptors."))))

;; What's the exit code for your?

;; Best regards

;; /Jörg