stopwatch.rkt

#lang slideshow

(require slideshow/play)

(provide timer-slide)

(module stopwatch racket
  (provide (all-defined-out))
  (define time? number?)
  (define (seconds n) n)
  (define (minutes n) (* 60 n))
  (define (hours n) (* 3600 n))
  (define (time->hhmmss x)
    (values (quotient x 3600)
            (quotient (remainder x 3600) 60)
            (remainder x 60)))
  (define (time->string x) 
    (let-values ([(hh mm ss) (time->hhmmss x)])
      (apply format "~a : ~a : ~a"
             (map (λ (x) (if (< (string-length x) 2)
                             (string-append "0" x)
                             x))
                  (map number->string (list hh mm ss)))))))

(require 'stopwatch)         

(set-page-numbers-visible! false) 

(define (stopwatch time)
  (local ([define current-time (box time)])
    (λ ()
      (let ([old-time (unbox current-time)])
        (if (zero? old-time)
            old-time
            (begin
              (set-box! current-time (- old-time (seconds 1)))
              old-time))))))

(define (time->pict period)
  (text period
        "Source Code Pro" 140))

(define (timer-slide #:title [msg ""] #:pict [pict time->pict] time)
  (let ([current-time (stopwatch time)])
    (play
     #:steps time
     #:delay 1
     #:title msg
     (λ (_)
         (pict (time->string (current-time)))))))


(timer-slide #:title "Exam Time"
             (+ (hours 2)
                (minutes 30)
                (seconds 0)))