# Swiss Railway Clock in Haskell

I wanted a small Haskell programming task to solve. I had just read about the controversy around the new Clock application in iOS 6 which is trademarked by the Swiss Federal Railway (see Swiss Railway Clock (Wikipedia)). The clock design is simple and elegant and I though that this would be a nice task to re-implement in Haskell.

I have used gloss for some projects before so this was my first choice to output some graphics. The project was small enough (58 LOC) to be completed in a few evenings.

• I started by measuring the different clock elements from a screenshot of the iOS application.
• Then I defined new types for the clocks hands and time marks which comprised the different characteristics.
• It turns out that most elements are just simple radial lines (RLine) through the center of the clock. draw_line handles all drawing except the dots on the second hand.
• Gloss support simple animations where all you need to do is to provide is a simple function which produce a Picture at a certain time (in seconds) after the program was started. See Graphics.Gloss.Interface.IO.Animate.
• So I get the initial system clock and time zone and feed that into my clock graphics generation function.

This is the resulting code.

module Main (main) where
import Graphics.Gloss
import System.Time

type Len = Float
type Angle = Float
type SubSecond = Float
data Face = Face { r_face :: Len, thick :: Len }        -- Center is assumed at origo
data RLine = RLine { len :: Len, width :: Len, r_tip :: Len, col :: Color }
newtype Mark = MarkC { mRLine :: RLine }
newtype Hand = HandC { hRLine :: RLine }
data SecHand = SecHandC { hand :: RLine, r_cent :: Len, r_outer :: Len }

-- Draw RLine at a certain angle. These are drawn through the center of the faceto r_tip.
-- If len > r_tip then the line passes through origo. Angle 0 is represented at 12 a clock direction.
draw_line :: RLine -> Angle -> Picture
draw_line (RLine len width r_tip col) a = Color col $Rotate a$ Translate 0 (-len/2+r_tip) $rectangleSolid width len where -- Draw clock face with a surrounding circle at radius, r and hour and minute marks draw_face :: Face -> Mark -> Mark -> Picture draw_face (Face r w) (MarkC h) (MarkC m) = pictures$ face ++ hour_marks ++ min_marks where
hour_marks = map (\a -> draw_line h a) [0,30..330]
min_marks = map (\a -> draw_line m a) [0,6..354]    -- TODO: Rem. hour marks
face = [ThickCircle r w]

-- Draw clock hands according to calendar time, t
draw_hands :: ClockTime -> SubSecond -> Hand -> Hand -> SecHand -> Picture
draw_hands ct ss (HandC h) (HandC m) (SecHandC s r1 r2) = Color (col s) $pictures$ hour ++ min ++ sec ++ dots where
t = toUTCTime ct
seconds = ss + (fromIntegral $ctSec t) -- set ss=0 if you want distinct seconds minutes = fromIntegral$ ctMin t
hours = fromIntegral $ctHour t hour = [draw_line h (30 * (hours + minutes/60))] min = [draw_line m (6 * minutes)] sec = [draw_line s (6 * seconds)] dots = [circleSolid r1, Translate sec_x sec_y (circleSolid r2)] sec_x = (r_tip s) * cos(sec_radians) sec_y = (r_tip s) * sin(sec_radians) sec_radians = (pi/2) - (pi/30) * seconds -- Get current local time zone diff in hours get_timezone :: ClockTime -> IO Int get_timezone ct = do cal <- toCalendarTime ct return ((ctTZ cal) div 3600) -- Draw clock with clock time (ct) and timezone (tz) (hours) and a time diff (td) (seconds) since start drawClock :: ClockTime -> Int -> Float -> Picture drawClock ct tz td = Translate trans trans$ Scale scale scale $picture where size = 600 scale = 0.4 trans = -0.0*(fromIntegral size) picture = pictures [draw_face face m_hour m_min, draw_hands ct' subsec h_hour h_min h_sec] -- Ugly way to handle timezone. This works because draw_hands use toUTCTime ct' = addToClockTime (TimeDiff 0 0 0 tz 0 sec 0) ct (sec, subsec) = properFraction td face = Face 714 5 m_hour = MarkC$ RLine 158 54 690 black
m_min = MarkC $RLine 68 12 690 black h_hour = HandC$ RLine 590 54 386 black
h_min = HandC \$ RLine 826 54 622 black
h_sec = SecHandC (RLine 626 16 445 red) 23 55

main = do
ct <- getClockTime
tz <- get_timezone ct
animate
(InWindow "Swiss Railway Clock by Apple" (600,600) (100,100))
white                   -- background color
(drawClock ct tz)       -- picture to display

A screenshot of the resulting clock shown below. Unfortunately gloss does not yet support anti-aliasing which would make the graphics more smooth.

I have generated a binary application for MacOS Lion.

• AppleClock?

To generate a new binary i used the following commands.

ghc -O2 -dylib-install-name /Applications/Xcode.app/Contents/Developer//Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.7.sdk/usr/lib AppleClock.hs
strip AppleClock -o AppleClockStrip

./AppleClockStrip