
Task
Write a small program that emulates a nautical bell producing a ringing bell pattern at certain times throughout the day.

The bell timing should be in accordance with Greenwich Mean Time, unless locale dictates otherwise.

It is permissible for the program to daemonize, or to slave off a scheduler, and it is permissible to use alternative notification methods (such as producing a written notice "Two Bells Gone"), if these are more usual for the system type.



Related task

 Sleep


#lang racket
 
(require racket/date)
 
(define HALF-HOUR-SECS (* 60 30))
 
;; given a date, return the seconds corresponding to the beginning
;; of that day (in local time)
(define (beginning-of-date d)
  (find-seconds 0 0 0 (date-day d) (date-month d) (date-year d)))
 
;; the seconds at the beginning of today:
(define today-secs
  (beginning-of-date
    (seconds->date (current-seconds))))
 
;; hours -> watch : given an hour, return the watch name
(define (hours->watch hours)
  (cond [(= 0 hours) "first"]
        [(< 0 hours 4.5) "middle"]
        [(< 4 hours 8.5) "morning"]
        [(< 8 hours 12.5) "forenoon"]
        [(< 12 hours 16.5) "afternoon"]
        [(< 16 hours 20.5) "dog"]
        [(< 20 hours 24.5) "first"]))
 
;; wait until current-seconds is the given number
(define (wait-til secs)
  (sleep (- secs (current-seconds))))
 
;; display the appropriate message
(define (format-and-print hours bells)
  (define int-hours (floor hours))
  (define minutes (cond [(integer? hours) "00"]
                        [else "30"]))
  (display
   (~a 
    (~a (floor hours) #:min-width 2 #:pad-string "0" 
        #:align 'right)
    ":" minutes ", " bells " bell(s) of the "
    (hours->watch hours) " watch "))
  ;; play the bells, if possible:
  (for ([i bells])
    (display "\a♪")
    (flush-output)
    (cond [(even? i) (sleep 0.5)]
          [(odd? i) (display " ") (sleep 1)]))
  (display "\n"))
 
;; start the loop:
(for ([s (in-range today-secs +inf.0 HALF-HOUR-SECS)]
      [bells (sequence-tail (in-cycle (in-range 8)) 7)]
      [hours (in-cycle (in-range 0 24 1/2))])
  ;; ignore the ones that have already happened:
  (when (< (current-seconds) s)
    (wait-til s)
    (format-and-print hours (add1 bells))))
 