(require (lib "animation.ss" "frtime")
(lib "gui.ss" "frtime"))
(define clock-radius (make-slider "Clock Size" 40 200 100))
(define (distance x1 y1 x2 y2)
(sqrt (+ (sqr (- x1 x2)) (sqr (- y1 y2)))))
(define clicks-in-clock
(left-clicks . =#> . (lambda (_)
(snapshot (mouse-pos clock-center clock-radius)
(<= (distance (posn-x mouse-pos)
(posn-y mouse-pos)
(posn-x clock-center)
(posn-y clock-center))
clock-radius)))))
(define offset
(hold
(clicks-in-clock
. -=> .
(snapshot (mouse-pos clock-center)
(posn- mouse-pos clock-center)))))
(define follow-mouse?
(hold (merge-e
clicks-in-clock
(left-releases . -=> . false)) #f))
(define clock-center
(rec p
(inf-delay
(until (make-posn 200 200)
(let ([p1 (posn- mouse-pos offset)])
(if follow-mouse?
p1
p))))))
(define second-hand-length (- clock-radius 5))
(define minute-hand-length (- clock-radius 5))
(define hour-hand-length (* .60 clock-radius))
(define number-position (- clock-radius 10))
(define number-offset-x -4)
(define number-offset-y 4)
(define the-date (seconds->date seconds))
(define the-hour (date-hour the-date))
(define the-minute (date-minute the-date))
(define the-second (date-second the-date))
(define (create-posn center radius slots value)
(make-posn (+ (posn-x center)
(* radius (cos (+ (* 3 (/ pi 2))
(* value (/ (* 2 pi) slots))))))
(+ (posn-y center)
(* radius (sin (+ (* 3 (/ pi 2))
(* value (/ (* 2 pi) slots))))))))
(define (create-number n)
(make-graph-string (create-posn
(make-posn (+ (posn-x clock-center) number-offset-x)
(+ (posn-y clock-center) number-offset-y))
number-position 12 (+ n 1))
(number->string (+ n 1))
"black"))
(define clock-face
(list (make-circle clock-center clock-radius (if follow-mouse?
"lightblue"
"white"))
(make-circle clock-center (/ clock-radius 20) "black")
(make-ring clock-center clock-radius "blue")
(build-list 12 create-number)))
(define hour-hand
(make-line clock-center
(create-posn clock-center
hour-hand-length 12
(+ the-hour (/ the-minute 60)))
"black"))
(define minute-hand
(make-line clock-center
(create-posn clock-center
minute-hand-length 60 the-minute)
"black"))
(define second-hand
(make-line clock-center
(create-posn clock-center
second-hand-length 60 the-second)
"red"))
(define analog-clock
(list clock-face hour-hand minute-hand second-hand))
(display-shapes analog-clock)