Skip to content

Instantly share code, notes, and snippets.

@DideC
Forked from greggirwin/analog-clock.red
Created June 15, 2016 08:59
Show Gist options
  • Save DideC/eb591a40dfe004d5be5c3915659e34ed to your computer and use it in GitHub Desktop.
Save DideC/eb591a40dfe004d5be5c3915659e34ed to your computer and use it in GitHub Desktop.
An analog clock for Red
Red [
Title: "Red O'clock"
Author: "Gregg Irwin"
]
degree-to-xy: func [rad "radius" deg "degrees"] [
as-pair (rad * sine deg) (rad * negate cosine deg)
]
sex-to-degree: func ["Sexagesimal to degrees" n] [n * 6]
; Positioning the hour hand isn't as easy as using the hour value
; directly, because it's not sexagesimal and we only have 12 hours
; on the clock for a 24 hour period. It's also nice if it doesn't
; just jump from one hour mark (= 5 ticks) to the next, but moves
; gradually between them based on the number of minutes.
hour-to-tick: func [
t [time!]] [5 * ((t/hour // 12) + ((to float! t/minute) / 60))
]
outer-wd: 4 ; thickness of outer ring
size: 200x200 ; overall clock size
radius: first size / 2
center: size / 2
hand-len: reduce ['hour radius * .65 'min radius * .85 'sec radius * .8]
; Start with the outer circle
draw-blk: compose [
pen red line-cap round
line-width (outer-wd) fill-pen white circle (center) (radius - outer-wd)
line-width 2 ; tick mark width
]
; Add tick marks
repeat i 60 [
tick-len: switch/default i [ ; Could do modulos here of course
15 30 45 60 [25]
5 10 20 25 35 40 50 55 [15]
][7]
p1: center + (degree-to-xy (radius - outer-wd) (sex-to-degree i))
p2: center + (degree-to-xy (radius - tick-len - outer-wd) (sex-to-degree i))
repend draw-blk ['line p1 p2]
]
; This is how we'll draw the hands. We just update line commands for them
; in the draw block each time.
update-hand: function [
hand [word!] "Maps to position in draw block"
tick [number!] "0-60"
][
; Position in draw block
pos: get select [hour hour-idx min min-idx sec sec-idx] hand
change pos reduce [
'line center (center + (degree-to-xy hand-len/:hand (sex-to-degree tick)))
]
]
t: now/time
hour-idx: min-idx: sec-idx: none
; This is a little funky. We add the setup for each hand to the draw
; block, mark that position, and then update the hand, which will add
; the line command for the hands the first time it is run. After that
; update-hand will modify the draw block rather than adding to it.
hour-idx: tail append draw-blk [pen crimson line-cap round line-width 4]
update-hand 'hour hour-to-tick t
min-idx: tail append draw-blk [line-width 3]
update-hand 'min t/minute
sec-idx: tail append draw-blk compose [line-width 1 pen brick fill-pen brick circle (center) 3]
update-hand 'sec t/second
view compose/only [
size (size)
origin 0x0
clock: base (size) draw (draw-blk) rate 1 on-time [
t: now/time
update-hand 'hour hour-to-tick t
update-hand 'min t/minute + ((to float! t/second) / 60)
update-hand 'sec t/second
]
do [
clock/color: none
]
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment