Browse Source

Very stupid clock ticking

master
Peter J. Jones 4 years ago
parent
commit
52d608a064
6 changed files with 108 additions and 33 deletions
  1. 2
    0
      .gitignore
  2. 4
    1
      clockdown.cabal
  3. 1
    1
      clockdown.hs
  4. 24
    0
      src/Clockdown/UI/Common/Action.hs
  5. 3
    31
      src/Clockdown/UI/Term/Draw.hs
  6. 74
    0
      src/Clockdown/UI/Term/Run.hs

+ 2
- 0
.gitignore View File

@@ -1,3 +1,5 @@
/default.nix
/dist/
/result
/.cabal-sandbox/
/cabal.sandbox.config

+ 4
- 1
clockdown.cabal View File

@@ -31,7 +31,9 @@ library
Clockdown.Core.Digital.Indicator
Clockdown.Core.Properties
Clockdown.Core.Window
Clockdown.UI.Common.Action
Clockdown.UI.Term.Draw
Clockdown.UI.Term.Run

default-language: Haskell2010
hs-source-dirs: src
@@ -41,7 +43,8 @@ library
ghc-options: -Werror
ghc-prof-options: -prof -auto-all

build-depends: base >= 4.7 && < 5.0
build-depends: async >= 2.0 && < 2.1
, base >= 4.7 && < 5.0
, text >= 0.11 && < 1.3
, time >= 1.5 && < 1.6
, vty >= 5.2 && < 5.3

+ 1
- 1
clockdown.hs View File

@@ -13,7 +13,7 @@ the LICENSE file.
module Main (main) where

--------------------------------------------------------------------------------
import qualified Clockdown.UI.Term.Draw as Clockdown
import qualified Clockdown.UI.Term.Run as Clockdown

--------------------------------------------------------------------------------
main :: IO ()

+ 24
- 0
src/Clockdown/UI/Common/Action.hs View File

@@ -0,0 +1,24 @@
{-

This file is part of the package clockdown. It is subject to the
license terms in the LICENSE file found in the top-level directory of
this distribution and at git://pmade.com/clockdown/LICENSE. No part of
the clockdown package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
module Clockdown.UI.Common.Action
( Action (..)
) where

--------------------------------------------------------------------------------
-- Library imports:
import Data.Time

--------------------------------------------------------------------------------
-- | Actions which can be triggered by the system or the user.
data Action = Tick UTCTime
-- ^ Update the clock.

+ 3
- 31
src/Clockdown/UI/Term/Draw.hs View File

@@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the package clockdown. It is subject to the
@@ -14,12 +12,12 @@ the LICENSE file.
--------------------------------------------------------------------------------
-- | Functions for creating Vty images to display a clock/timer.
module Clockdown.UI.Term.Draw
( run
( drawDisplay
, centerImage
) where

--------------------------------------------------------------------------------
-- Library imports:
import Data.Time
import Graphics.Vty
import Graphics.Vty.Prelude

@@ -27,8 +25,7 @@ import Graphics.Vty.Prelude
-- Local imports:
import Clockdown.Core.Digital.Display
import Clockdown.Core.Digital.Indicator
import Clockdown.Core.Properties
import Clockdown.Core.Window
-- import Clockdown.Core.Properties

--------------------------------------------------------------------------------
-- | Draw a single indicator into a Vty image.
@@ -96,29 +93,3 @@ centerImage display image = translate x y image
where
x = (regionWidth display `div` 2) - (imageWidth image `div` 2)
y = (regionHeight display `div` 2) - (imageHeight image `div` 2)

--------------------------------------------------------------------------------
run :: IO ()
run = do
cfg <- standardIOConfig
vty <- mkVty cfg
tz <- getCurrentTimeZone
go vty $ makeClock (Properties "foo") tz
shutdown vty

where
go vty clock = do
now <- getCurrentTime
region <- displayBounds (outputIface vty)

let display = windowDigitalDisplay clock now
update vty $ picForImage (centerImage region $ drawDisplay display)

e <- nextEvent vty
case e of
EvKey KEsc [] -> return ()
EvKey (KChar '+') [] -> go vty (windowSucc clock)
EvKey (KChar '=') [] -> go vty (windowSucc clock)
EvKey (KChar '-') [] -> go vty (windowPred clock)
_ -> go vty clock

+ 74
- 0
src/Clockdown/UI/Term/Run.hs View File

@@ -0,0 +1,74 @@
{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the package clockdown. It is subject to the
license terms in the LICENSE file found in the top-level directory of
this distribution and at git://pmade.com/clockdown/LICENSE. No part of
the clockdown package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
module Clockdown.UI.Term.Run
( run
) where

--------------------------------------------------------------------------------
-- Library imports:
import Control.Concurrent
import Control.Concurrent.Async
import Control.Monad
import Data.Time
import Graphics.Vty

--------------------------------------------------------------------------------
-- Local imports:
import Clockdown.Core.Properties
import Clockdown.Core.Window
import Clockdown.UI.Common.Action
import Clockdown.UI.Term.Draw

--------------------------------------------------------------------------------
tickThread :: Chan Action -> IO ()
tickThread channel = forever $ do
now <- getCurrentTime
writeChan channel (Tick now)
threadDelay 1000000

--------------------------------------------------------------------------------
drawThread :: Vty -> Chan Action -> IO ()
drawThread vty channel = forever $ do
tz <- getCurrentTimeZone
action <- readChan channel

case action of
Tick t -> do
let clock = makeClock (Properties "foo") tz
display = windowDigitalDisplay clock t
region <- displayBounds (outputIface vty)
update vty $ picForImage (centerImage region $ drawDisplay display)

--------------------------------------------------------------------------------
-- | Temporary function for testing the drawing functions.
run :: IO ()
run = do
cfg <- standardIOConfig
vty <- mkVty cfg
channel <- newChan
ticker <- async (tickThread channel)

withAsync (drawThread vty channel) $ \_ -> do
go vty
shutdown vty
cancel ticker

where
go vty = do
e <- nextEvent vty

case e of
EvKey KEsc [] -> return ()
_ -> go vty

Loading…
Cancel
Save