Terminal clock and countdown timer
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

Run.hs 2.2KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374
  1. {-# LANGUAGE OverloadedStrings #-}
  2. {-
  3. This file is part of the package clockdown. It is subject to the
  4. license terms in the LICENSE file found in the top-level directory of
  5. this distribution and at git://pmade.com/clockdown/LICENSE. No part of
  6. the clockdown package, including this file, may be copied, modified,
  7. propagated, or distributed except according to the terms contained in
  8. the LICENSE file.
  9. -}
  10. --------------------------------------------------------------------------------
  11. module Clockdown.UI.Term.Run
  12. ( run
  13. ) where
  14. --------------------------------------------------------------------------------
  15. -- Library imports:
  16. import Control.Concurrent
  17. import Control.Concurrent.Async
  18. import Control.Monad
  19. import Data.Time
  20. import Graphics.Vty
  21. --------------------------------------------------------------------------------
  22. -- Local imports:
  23. import Clockdown.Core.Properties
  24. import Clockdown.Core.Window
  25. import Clockdown.UI.Common.Action
  26. import Clockdown.UI.Term.Draw
  27. --------------------------------------------------------------------------------
  28. tickThread :: Chan Action -> IO ()
  29. tickThread channel = forever $ do
  30. now <- getCurrentTime
  31. writeChan channel (Tick now)
  32. threadDelay 1000000
  33. --------------------------------------------------------------------------------
  34. drawThread :: Vty -> Chan Action -> IO ()
  35. drawThread vty channel = forever $ do
  36. tz <- getCurrentTimeZone
  37. action <- readChan channel
  38. case action of
  39. Tick t -> do
  40. let clock = makeClock (Properties "foo") tz
  41. display = windowDigitalDisplay clock t
  42. region <- displayBounds (outputIface vty)
  43. update vty $ picForImage (centerImage region $ drawDisplay display)
  44. --------------------------------------------------------------------------------
  45. -- | Temporary function for testing the drawing functions.
  46. run :: IO ()
  47. run = do
  48. cfg <- standardIOConfig
  49. vty <- mkVty cfg
  50. channel <- newChan
  51. ticker <- async (tickThread channel)
  52. withAsync (drawThread vty channel) $ \_ -> do
  53. go vty
  54. shutdown vty
  55. cancel ticker
  56. where
  57. go vty = do
  58. e <- nextEvent vty
  59. case e of
  60. EvKey KEsc [] -> return ()
  61. _ -> go vty