Browse Source

Add optional messages

master
Peter J. Jones 4 years ago
parent
commit
9693dfd73e

+ 10
- 4
src/Clockdown/Core/Config.hs View File

@@ -87,8 +87,11 @@ defaultClock tz = (defaultClockName, clock)
clock = Clock props tz

props :: Properties
props = Properties { propName = defaultClockName -- %b. %d, %Y
, propColor = blue
props = Properties { propName = defaultClockName
, propColor = blue
, propMessage = Just "%b. %d, %Y"
, propMessageColor = Nothing
, propTimeLocale = defaultTimeLocale
}

--------------------------------------------------------------------------------
@@ -109,6 +112,9 @@ defaultCountdown = (defaultCountdownName, countdown)
}

props :: Properties
props = Properties { propName = defaultCountdownName
, propColor = green
props = Properties { propName = defaultCountdownName
, propColor = green
, propMessage = Just "Break Time!"
, propMessageColor = Nothing
, propTimeLocale = defaultTimeLocale
}

+ 6
- 5
src/Clockdown/Core/Properties.hs View File

@@ -18,6 +18,7 @@ module Clockdown.Core.Properties
--------------------------------------------------------------------------------
-- Library imports:
import Data.Text (Text)
import Data.Time

--------------------------------------------------------------------------------
-- Local imports:
@@ -25,9 +26,9 @@ import Clockdown.Core.Color

--------------------------------------------------------------------------------
data Properties = Properties
{ propName :: Text -- ^ The name of the window.
, propColor :: Color -- ^ The main color.
-- TODO: Time color
-- TODO: string message
-- TODO: string color
{ propName :: Text -- ^ The name of the window.
, propColor :: Color -- ^ The main color.
, propMessage :: Maybe Text -- ^ An optional message to display.
, propMessageColor :: Maybe Color -- ^ Color of the optional message.
, propTimeLocale :: TimeLocale -- ^ Message locale.
}

+ 29
- 2
src/Clockdown/UI/Term/Draw.hs View File

@@ -12,12 +12,15 @@ the LICENSE file.
--------------------------------------------------------------------------------
-- | Functions for creating Vty images to display a clock/timer.
module Clockdown.UI.Term.Draw
( drawDisplay
, centerImage
( drawWindow
) where

--------------------------------------------------------------------------------
-- Library imports:
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time
import Graphics.Vty
import Graphics.Vty.Prelude

@@ -27,6 +30,16 @@ import qualified Clockdown.Core.Color as C
import Clockdown.Core.Digital.Display
import Clockdown.Core.Digital.Indicator
import Clockdown.Core.Properties
import Clockdown.Core.Window

--------------------------------------------------------------------------------
drawWindow :: UTCTime -> Window -> DisplayRegion -> Image
drawWindow t w r = vertCat [ timeDigits, message ]
where
display = windowDigitalDisplay w t
props = windowProperties w
timeDigits = centerImage r $ drawDisplay props display
message = centerImage (regionWidth r, 1) $ drawMessage props t

--------------------------------------------------------------------------------
-- | Draw a single indicator into a Vty image.
@@ -66,6 +79,20 @@ drawSep props = withBorder [ string defAttr " "
where
c = vtyColor (propColor props)

--------------------------------------------------------------------------------
drawMessage :: Properties -> UTCTime -> Image
drawMessage p t =
case propMessage p of
Nothing -> emptyImage
Just msg -> string (defAttr `withForeColor` color) (format msg)

where
format :: Text -> String
format s = formatTime (propTimeLocale p) (Text.unpack s) t

color :: Color
color = vtyColor $ fromMaybe (propColor p) (propMessageColor p)

--------------------------------------------------------------------------------
-- | Draw an entire display into a Vty image.
drawDisplay :: Properties -> Display -> Image

+ 2
- 6
src/Clockdown/UI/Term/Run.hs View File

@@ -59,17 +59,13 @@ drawThread = forever $ do
env <- asks private
tick <- dispatch =<< liftIO (readChan $ channel env)
window <- gets focus
liftIO (draw (vty env) tick window)
liftIO $ draw (vty env) tick window

where
draw :: Vty -> UTCTime -> Window -> IO ()
draw v t w = do
let display = windowDigitalDisplay w t
props = windowProperties w
image = drawDisplay props display

region <- displayBounds (outputIface v)
update v $ picForImage (centerImage region image)
update v (picForImage $ drawWindow t w region)

--------------------------------------------------------------------------------
-- | Temporary function for testing the drawing functions.

Loading…
Cancel
Save