clock.rkt

#lang racket
(require racket/gui)
(require racket/date)

(define current-time #(0 0 0)) ;#(h m s)
(define tau (* 2 pi))
(define time->str
  (λ (t)
     (~a (~r (vector-ref t 0) #:min-width 2 #:pad-string "0")
         ":"
         (~r (vector-ref t 1) #:min-width 2 #:pad-string "0")
         ":"
         (~r (vector-ref t 2) #:min-width 2 #:pad-string "0"))))
(define reset-time!
  (λ (date)
     (set! current-time (vector (date-hour date) (date-minute date) (date-second date)))))
(reset-time! (current-date))

(define next-time
  (λ (t)
     (let ([h (vector-ref t 0)]
           [m (vector-ref t 1)]
           [s (vector-ref t 2)])
       (vector (if (and (eq? m 59) (eq? s 59)) (modulo (add1 h) 12) h)
               (if (eq? s 59) (modulo (add1 m) 60) m)
               (modulo (add1 s) 60)))))

#| given a vector #(hours minutes seconds), return a vector of radian angles |#
(define get-angles
  (λ (timevec)
     (let ([h (/ (modulo (vector-ref timevec 0) 12) 12)]
           [m (/ (modulo (vector-ref timevec 1) 60) 60)]
           [s (/ (modulo (vector-ref timevec 2) 60) 60)])
       (vector (* tau (+ h (/ m 12) (/ s 12 60)))
               (* tau (+ m (/ s 60)))
               (* tau s)))))
#| given a point (cen-x cen-y), an angle theta, and a lenth len
return vector containing (x, y) coordinates of point forming triangle
with (cen-x, cen-y) and (cen-x, 0) |#
(define get-coord
  (λ (cen-x cen-y theta len)
     (vector (+ cen-x (* len (sin theta)))
             (- cen-y (* len (cos theta))))))

#| some gui stuff |#
(define my-frame%
  (class frame%
         (override on-size )
         (define on-size
           (λ (w h)
              (let ([s (if (zero? (random 1)) w h)])
                (send this resize s s))))
         (define on-close
           (λ ()
              (kill-thread updater)
              (exit)))
         (super-new)))
(define frame
  (new frame%
       [label "clock"]
       [min-width 120]
       [min-height 120]
       [enabled #t]))
(define my-canvas%
  (class canvas%
         (override on-paint)
         (define on-paint ;called on canvas refresh
           (λ () (let ([dc (send this get-dc)]
                           [w (send this get-width)]
                           [h (send this get-height)])
                      (let ([c (/ (min w h) 2)]
                            [current-angles (get-angles current-time)])
                        (send dc clear)
                        (send dc set-pen "black" 2 'solid)
                        (send dc draw-ellipse 0 0 (* c 2) (* c 2))
                        ; draw hour hand
                        (send dc set-pen "black" 5 'solid)
                        (let ([p (get-coord c c (vector-ref current-angles 0) (* c 0.5))])
                          (send dc draw-line 
                                c
                                c
                                (vector-ref p 0)
                                (vector-ref p 1)))
                        ; draw minute hand
                        (send dc set-pen "black" 3 'solid)
                        (let ([p (get-coord c c (vector-ref current-angles 1) (* c 0.75))])
                          (send dc draw-line 
                                c
                                c
                                (vector-ref p 0)
                                (vector-ref p 1)))
                        ; draw second hand
                        (send dc set-pen "black" 1 'solid)
                        (let ([p (get-coord c c (vector-ref current-angles 2) (* c 0.9))])
                          (send dc draw-line 
                                c
                                c
                                (vector-ref p 0)
                                (vector-ref p 1)))

                        ; draw digital time
                        (send dc draw-text (time->str current-time) 0 0)
                        ))))
         (super-new)))

(define canvas
  (new my-canvas%
       [parent frame]
       [style '(border)]))
(send frame show #t)

;update time and redraw every second
(define updater
  (thread
    (λ ()
       (let loop ((n 0))
         (sleep 1)
         (set! current-time (next-time current-time))
         (send canvas refresh)
         #| try to correct for drift periodically (currently every 24 hours) |#
         (when [> n 86400] 
           (reset-time! (current-date))
           (loop 0))
         (loop (add1 n))))))