Browse Source

Wow, it can actually draw a clock!

master
Peter J. Jones 4 years ago
parent
commit
ccd192e67c

+ 1
- 0
.gitignore View File

@@ -1,2 +1,3 @@
/default.nix
/dist/
/result

+ 15
- 0
clockdown.cabal View File

@@ -26,8 +26,12 @@ flag maintainer
--------------------------------------------------------------------------------
library
exposed-modules:
Clockdown.Core.Clock
Clockdown.Core.Digital.Display
Clockdown.Core.Digital.Indicator
Clockdown.Core.Properties
Clockdown.Core.Window
Clockdown.UI.Term.Draw

default-language: Haskell2010
hs-source-dirs: src
@@ -38,9 +42,19 @@ library
ghc-prof-options: -prof -auto-all

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

--------------------------------------------------------------------------------
executable clockdown
default-language: Haskell2010
main-is: clockdown.hs
build-depends: base, clockdown
ghc-options: -Wall -fwarn-incomplete-uni-patterns -threaded

if flag(maintainer)
ghc-options: -Werror

--------------------------------------------------------------------------------
test-suite test

+ 20
- 0
clockdown.hs View File

@@ -0,0 +1,20 @@
{-

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 Main (main) where

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

--------------------------------------------------------------------------------
main :: IO ()
main = Clockdown.run

+ 56
- 0
src/Clockdown/Core/Clock.hs View File

@@ -0,0 +1,56 @@
{-

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.Core.Clock
( Clock (..)
, clockDigitalDisplay
, clockForward
, clockBackward
) where

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

--------------------------------------------------------------------------------
-- Local imports:
import qualified Clockdown.Core.Digital.Display as Digital
import Clockdown.Core.Properties

--------------------------------------------------------------------------------
data Clock = Clock
{ clockProps :: Properties
, clockTimeZone :: TimeZone
}

--------------------------------------------------------------------------------
clockDigitalDisplay :: Clock -> UTCTime -> Digital.Display
clockDigitalDisplay c t = Digital.digitalClock (localTimeOfDay time)
where time = utcToLocalTime (clockTimeZone c) t

--------------------------------------------------------------------------------
-- | Move a clock forward one hour.
clockForward :: Clock -> Clock
clockForward = modifyClockTZ (+60)

--------------------------------------------------------------------------------
-- | Move a clock backward one hour.
clockBackward :: Clock -> Clock
clockBackward = modifyClockTZ (subtract 60)

--------------------------------------------------------------------------------
-- | Helper function to alter a clock's time zone.
modifyClockTZ :: (Int -> Int) -> Clock -> Clock
modifyClockTZ f c = c {clockTimeZone = newTZ}
where
newMin = f (timeZoneMinutes $ clockTimeZone c)
newTZ = (clockTimeZone c) {timeZoneMinutes = newMin}

+ 3
- 3
src/Clockdown/Core/Digital/Display.hs View File

@@ -13,7 +13,7 @@ the LICENSE file.
-- | A digital display containing four seven-segment indicators.
module Clockdown.Core.Digital.Display
( Display (..)
, clock
, digitalClock
, countDown
) where

@@ -37,8 +37,8 @@ data Display = Display
--------------------------------------------------------------------------------
-- | Create a display suitable for showing a clock consisting of hours
-- and minutes. The indicators will read from left to right: @H H M M@.
clock :: TimeOfDay -> Display
clock t = display (todHour t) (todMin t)
digitalClock :: TimeOfDay -> Display
digitalClock t = display (todHour t) (todMin t)

--------------------------------------------------------------------------------
-- | Create a display to show the number of seconds remaining in a

+ 3
- 3
src/Clockdown/Core/Digital/Indicator.hs View File

@@ -15,7 +15,7 @@ module Clockdown.Core.Digital.Indicator
( Indicator
, Segment (..)
, indicator
, testSegment
, hasSeg
) where

--------------------------------------------------------------------------------
@@ -62,5 +62,5 @@ indicator n = Indicator $

--------------------------------------------------------------------------------
-- | Test to see if an indicator should be lit up.
testSegment :: Indicator -> Segment -> Bool
testSegment (Indicator bits) = testBit bits . fromEnum
hasSeg :: Indicator -> Segment -> Bool
hasSeg (Indicator bits) = testBit bits . fromEnum

+ 27
- 0
src/Clockdown/Core/Properties.hs View File

@@ -0,0 +1,27 @@
{-

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.

-}

--------------------------------------------------------------------------------
-- | Because I suck at naming things.
module Clockdown.Core.Properties
( Properties (..)
) where

--------------------------------------------------------------------------------
import Data.Text (Text)

--------------------------------------------------------------------------------
data Properties = Properties
{ propName :: Text
-- TODO: Time color
-- TODO: string message
-- TODO: string color
}

+ 59
- 0
src/Clockdown/Core/Window.hs View File

@@ -0,0 +1,59 @@
{-

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.Core.Window
( Window
, makeClock
, windowDigitalDisplay
, windowProperties
, windowSucc
, windowPred
) where

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

--------------------------------------------------------------------------------
-- Local imports:
import Clockdown.Core.Clock
import qualified Clockdown.Core.Digital.Display as Digital
import Clockdown.Core.Properties

--------------------------------------------------------------------------------
-- | A type to hold the information about what should be displayed in
-- a window.
data Window = ClockWin Clock

--------------------------------------------------------------------------------
makeClock :: Properties -> TimeZone -> Window
makeClock p = ClockWin . Clock p

--------------------------------------------------------------------------------
-- | Convert a window into a digital display.
windowDigitalDisplay :: Window -> UTCTime -> Digital.Display
windowDigitalDisplay (ClockWin c) = clockDigitalDisplay c

--------------------------------------------------------------------------------
-- | Get the display properties for a window.
windowProperties :: Window -> Properties
windowProperties (ClockWin c) = clockProps c

--------------------------------------------------------------------------------
-- | Move the time shown in a window forward by some amount.
windowSucc :: Window -> Window
windowSucc (ClockWin c) = ClockWin (clockForward c)

--------------------------------------------------------------------------------
-- | Move the time show in a window backward by some amount.
windowPred :: Window -> Window
windowPred (ClockWin c) = ClockWin (clockBackward c)

+ 124
- 0
src/Clockdown/UI/Term/Draw.hs View File

@@ -0,0 +1,124 @@
{-# 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.

-}

--------------------------------------------------------------------------------
-- | Functions for creating Vty images to display a clock/timer.
module Clockdown.UI.Term.Draw
( run
) where

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

--------------------------------------------------------------------------------
-- Local imports:
import Clockdown.Core.Digital.Display
import Clockdown.Core.Digital.Indicator
import Clockdown.Core.Properties
import Clockdown.Core.Window

--------------------------------------------------------------------------------
-- | Draw a single indicator into a Vty image.
drawIndicator :: Indicator -> Image
drawIndicator ssd =
withBorder [ paintA F A B
, paintB F B
, paintA F G B
, paintB E C
, paintA E D C
]
where
on = defAttr `withBackColor` blue
off = defAttr

whichAttr b = if b then on else off
paint n b = string (whichAttr b) $ replicate n ' '

paintA a b c = if ssd `hasSeg` b
then paint 6 True
else paintB a c

paintB a b = horizCat [ paint 2 (ssd `hasSeg` a)
, paint 2 False
, paint 2 (ssd `hasSeg` b)
]

--------------------------------------------------------------------------------
-- | Draw the time separator into a Vty image.
drawSep :: Image
drawSep = withBorder [ string defAttr " "
, string (defAttr `withBackColor` blue) " "
, string defAttr " "
, string (defAttr `withBackColor` blue) " "
, string defAttr " "
]

--------------------------------------------------------------------------------
-- | Draw an entire display into a Vty image.
drawDisplay :: Display -> Image
drawDisplay d = horizCat [ drawIndicator (indicator0 d)
, drawIndicator (indicator1 d)
, drawSep
, drawIndicator (indicator2 d)
, drawIndicator (indicator3 d)
]

--------------------------------------------------------------------------------
-- | Add a border around the given images.
withBorder :: [Image] -> Image
withBorder [] = emptyImage
withBorder imgs@(x:_) =
vertCat [ hBorder
, vertCat (map vBorder imgs)
, hBorder
]
where
hBorder = string defAttr $ replicate (imageWidth x) ' '
vBorder img = horizCat [char defAttr ' ', img, char defAttr ' ']

--------------------------------------------------------------------------------
-- | Center the given image on the current Vty display.
centerImage :: DisplayRegion -> Image -> Image
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)

--------------------------------------------------------------------------------
-- | Temporary function for testing the drawing functions.
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

+ 2
- 2
test/IndicatorTest.hs View File

@@ -32,8 +32,8 @@ segmentsTest =
check digit table seg =
assertBool ("Segment: " ++ show seg ++ " from " ++ show digit) $
case lookup seg table of
Nothing -> not (indicator digit `testSegment` seg)
Just _ -> indicator digit `testSegment` seg
Nothing -> not (indicator digit `hasSeg` seg)
Just _ -> indicator digit `hasSeg` seg

testCases :: [(Int, [Segment])]
testCases = [ (0, [A, B, C, D, E, F ])

Loading…
Cancel
Save