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 @@
1 1
 /default.nix
2
+/dist/
2 3
 /result

+ 15
- 0
clockdown.cabal View File

@@ -26,8 +26,12 @@ flag maintainer
26 26
 --------------------------------------------------------------------------------
27 27
 library
28 28
   exposed-modules:
29
+    Clockdown.Core.Clock
29 30
     Clockdown.Core.Digital.Display
30 31
     Clockdown.Core.Digital.Indicator
32
+    Clockdown.Core.Properties
33
+    Clockdown.Core.Window
34
+    Clockdown.UI.Term.Draw
31 35
 
32 36
   default-language: Haskell2010
33 37
   hs-source-dirs: src
@@ -38,9 +42,19 @@ library
38 42
     ghc-prof-options: -prof -auto-all
39 43
 
40 44
   build-depends: base          >= 4.7  && < 5.0
45
+               , text          >= 0.11 && < 1.3
41 46
                , time          >= 1.5  && < 1.6
47
+               , vty           >= 5.2  && < 5.3
42 48
 
49
+--------------------------------------------------------------------------------
50
+executable clockdown
51
+  default-language: Haskell2010
52
+  main-is: clockdown.hs
53
+  build-depends: base, clockdown
54
+  ghc-options: -Wall -fwarn-incomplete-uni-patterns -threaded
55
+
56
+  if flag(maintainer)
57
+    ghc-options: -Werror
43 58
 
44 59
 --------------------------------------------------------------------------------
45 60
 test-suite test

+ 20
- 0
clockdown.hs View File

@@ -0,0 +1,20 @@
1
+{-
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
+
12
+--------------------------------------------------------------------------------
13
+module Main (main) where
14
+
15
+--------------------------------------------------------------------------------
16
+import qualified Clockdown.UI.Term.Draw as Clockdown
17
+
18
+--------------------------------------------------------------------------------
19
+main :: IO ()
20
+main = Clockdown.run

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

@@ -0,0 +1,56 @@
1
+{-
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
+
12
+--------------------------------------------------------------------------------
13
+module Clockdown.Core.Clock
14
+       ( Clock (..)
15
+       , clockDigitalDisplay
16
+       , clockForward
17
+       , clockBackward
18
+       ) where
19
+
20
+--------------------------------------------------------------------------------
21
+-- Library imports:
22
+import Data.Time
23
+
24
+--------------------------------------------------------------------------------
25
+-- Local imports:
26
+import qualified Clockdown.Core.Digital.Display as Digital
27
+import Clockdown.Core.Properties
28
+
29
+--------------------------------------------------------------------------------
30
+data Clock = Clock
31
+  { clockProps    :: Properties
32
+  , clockTimeZone :: TimeZone
33
+  }
34
+
35
+--------------------------------------------------------------------------------
36
+clockDigitalDisplay :: Clock -> UTCTime -> Digital.Display
37
+clockDigitalDisplay c t = Digital.digitalClock (localTimeOfDay time)
38
+  where time = utcToLocalTime (clockTimeZone c) t
39
+
40
+--------------------------------------------------------------------------------
41
+-- | Move a clock forward one hour.
42
+clockForward :: Clock -> Clock
43
+clockForward = modifyClockTZ (+60)
44
+
45
+--------------------------------------------------------------------------------
46
+-- | Move a clock backward one hour.
47
+clockBackward :: Clock -> Clock
48
+clockBackward = modifyClockTZ (subtract 60)
49
+
50
+--------------------------------------------------------------------------------
51
+-- | Helper function to alter a clock's time zone.
52
+modifyClockTZ :: (Int -> Int) -> Clock -> Clock
53
+modifyClockTZ f c = c {clockTimeZone = newTZ}
54
+  where
55
+    newMin = f (timeZoneMinutes $ clockTimeZone c)
56
+    newTZ = (clockTimeZone c) {timeZoneMinutes = newMin}

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

@@ -13,7 +13,7 @@ the LICENSE file.
13 13
 -- | A digital display containing four seven-segment indicators.
14 14
 module Clockdown.Core.Digital.Display
15 15
        ( Display (..)
16
-       , clock
16
+       , digitalClock
17 17
        , countDown
18 18
        ) where
19 19
 
@@ -37,8 +37,8 @@ data Display = Display
37 37
 --------------------------------------------------------------------------------
38 38
 -- | Create a display suitable for showing a clock consisting of hours
39 39
 -- and minutes.  The indicators will read from left to right: @H H M M@.
40
-clock :: TimeOfDay -> Display
41
-clock t = display (todHour t) (todMin t)
40
+digitalClock :: TimeOfDay -> Display
41
+digitalClock t = display (todHour t) (todMin t)
42 42
 
43 43
 --------------------------------------------------------------------------------
44 44
 -- | 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
15 15
        ( Indicator
16 16
        , Segment (..)
17 17
        , indicator
18
-       , testSegment
18
+       , hasSeg
19 19
        ) where
20 20
 
21 21
 --------------------------------------------------------------------------------
@@ -62,5 +62,5 @@ indicator n = Indicator $
62 62
 
63 63
 --------------------------------------------------------------------------------
64 64
 -- | Test to see if an indicator should be lit up.
65
-testSegment :: Indicator -> Segment -> Bool
66
-testSegment (Indicator bits) = testBit bits . fromEnum
65
+hasSeg :: Indicator -> Segment -> Bool
66
+hasSeg (Indicator bits) = testBit bits . fromEnum

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

@@ -0,0 +1,27 @@
1
+{-
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
+
12
+--------------------------------------------------------------------------------
13
+-- | Because I suck at naming things.
14
+module Clockdown.Core.Properties
15
+       ( Properties (..)
16
+       ) where
17
+
18
+--------------------------------------------------------------------------------
19
+import Data.Text (Text)
20
+
21
+--------------------------------------------------------------------------------
22
+data Properties = Properties
23
+  { propName :: Text
24
+    -- TODO: Time color
25
+    -- TODO: string message
26
+    -- TODO: string color
27
+  }

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

@@ -0,0 +1,59 @@
1
+{-
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
+
12
+--------------------------------------------------------------------------------
13
+module Clockdown.Core.Window
14
+       ( Window
15
+       , makeClock
16
+       , windowDigitalDisplay
17
+       , windowProperties
18
+       , windowSucc
19
+       , windowPred
20
+       ) where
21
+
22
+--------------------------------------------------------------------------------
23
+-- Library imports:
24
+import Data.Time
25
+
26
+--------------------------------------------------------------------------------
27
+-- Local imports:
28
+import Clockdown.Core.Clock
29
+import qualified Clockdown.Core.Digital.Display as Digital
30
+import Clockdown.Core.Properties
31
+
32
+--------------------------------------------------------------------------------
33
+-- | A type to hold the information about what should be displayed in
34
+-- a window.
35
+data Window = ClockWin Clock
36
+
37
+--------------------------------------------------------------------------------
38
+makeClock :: Properties -> TimeZone -> Window
39
+makeClock p = ClockWin . Clock p
40
+
41
+--------------------------------------------------------------------------------
42
+-- | Convert a window into a digital display.
43
+windowDigitalDisplay :: Window -> UTCTime -> Digital.Display
44
+windowDigitalDisplay (ClockWin c) = clockDigitalDisplay c
45
+
46
+--------------------------------------------------------------------------------
47
+-- | Get the display properties for a window.
48
+windowProperties :: Window -> Properties
49
+windowProperties (ClockWin c) = clockProps c
50
+
51
+--------------------------------------------------------------------------------
52
+-- | Move the time shown in a window forward by some amount.
53
+windowSucc :: Window -> Window
54
+windowSucc (ClockWin c) = ClockWin (clockForward c)
55
+
56
+--------------------------------------------------------------------------------
57
+-- | Move the time show in a window backward by some amount.
58
+windowPred :: Window -> Window
59
+windowPred (ClockWin c) = ClockWin (clockBackward c)

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

@@ -0,0 +1,124 @@
1
+{-# LANGUAGE OverloadedStrings #-}
2
+
3
+{-
4
+
5
+This file is part of the package clockdown. It is subject to the
6
+license terms in the LICENSE file found in the top-level directory of
7
+this distribution and at git://pmade.com/clockdown/LICENSE. No part of
8
+the clockdown package, including this file, may be copied, modified,
9
+propagated, or distributed except according to the terms contained in
10
+the LICENSE file.
11
+
12
+-}
13
+
14
+--------------------------------------------------------------------------------
15
+-- | Functions for creating Vty images to display a clock/timer.
16
+module Clockdown.UI.Term.Draw
17
+       ( run
18
+       ) where
19
+
20
+--------------------------------------------------------------------------------
21
+-- Library imports:
22
+import Data.Time
23
+import Graphics.Vty
24
+import Graphics.Vty.Prelude
25
+
26
+--------------------------------------------------------------------------------
27
+-- Local imports:
28
+import Clockdown.Core.Digital.Display
29
+import Clockdown.Core.Digital.Indicator
30
+import Clockdown.Core.Properties
31
+import Clockdown.Core.Window
32
+
33
+--------------------------------------------------------------------------------
34
+-- | Draw a single indicator into a Vty image.
35
+drawIndicator :: Indicator -> Image
36
+drawIndicator ssd =
37
+  withBorder [ paintA F A B
38
+             , paintB F B
39
+             , paintA F G B
40
+             , paintB E C
41
+             , paintA E D C
42
+             ]
43
+  where
44
+    on  = defAttr `withBackColor` blue
45
+    off = defAttr
46
+
47
+    whichAttr b = if b then on else off
48
+    paint n b = string (whichAttr b) $ replicate n ' '
49
+
50
+    paintA a b c = if ssd `hasSeg` b
51
+                      then paint 6 True
52
+                      else paintB a c
53
+
54
+    paintB a b = horizCat [ paint 2 (ssd `hasSeg` a)
55
+                          , paint 2 False
56
+                          , paint 2 (ssd `hasSeg` b)
57
+                          ]
58
+
59
+--------------------------------------------------------------------------------
60
+-- | Draw the time separator into a Vty image.
61
+drawSep :: Image
62
+drawSep = withBorder [ string defAttr "  "
63
+                     , string (defAttr `withBackColor` blue) "  "
64
+                     , string defAttr "  "
65
+                     , string (defAttr `withBackColor` blue) "  "
66
+                     , string defAttr "  "
67
+                     ]
68
+
69
+--------------------------------------------------------------------------------
70
+-- | Draw an entire display into a Vty image.
71
+drawDisplay :: Display -> Image
72
+drawDisplay d = horizCat [ drawIndicator (indicator0 d)
73
+                         , drawIndicator (indicator1 d)
74
+                         , drawSep
75
+                         , drawIndicator (indicator2 d)
76
+                         , drawIndicator (indicator3 d)
77
+                         ]
78
+
79
+--------------------------------------------------------------------------------
80
+-- | Add a border around the given images.
81
+withBorder :: [Image] -> Image
82
+withBorder []         = emptyImage
83
+withBorder imgs@(x:_) =
84
+  vertCat [ hBorder
85
+          , vertCat (map vBorder imgs)
86
+          , hBorder
87
+          ]
88
+  where
89
+    hBorder = string defAttr $ replicate (imageWidth x) ' '
90
+    vBorder img = horizCat [char defAttr ' ', img, char defAttr ' ']
91
+
92
+--------------------------------------------------------------------------------
93
+-- | Center the given image on the current Vty display.
94
+centerImage :: DisplayRegion -> Image -> Image
95
+centerImage display image = translate x y image
96
+  where
97
+    x = (regionWidth  display `div` 2) - (imageWidth  image `div` 2)
98
+    y = (regionHeight display `div` 2) - (imageHeight image `div` 2)
99
+
100
+--------------------------------------------------------------------------------
101
+-- | Temporary function for testing the drawing functions.
102
+run :: IO ()
103
+run = do
104
+  cfg <- standardIOConfig
105
+  vty <- mkVty cfg
106
+  tz  <- getCurrentTimeZone
107
+  go vty $ makeClock (Properties "foo") tz
108
+  shutdown vty
109
+
110
+  where
111
+    go vty clock = do
112
+      now <- getCurrentTime
113
+      region <- displayBounds (outputIface vty)
114
+
115
+      let display = windowDigitalDisplay clock now
116
+      update vty $ picForImage (centerImage region $ drawDisplay display)
117
+
118
+      e <- nextEvent vty
119
+      case e of
120
+        EvKey KEsc []        -> return ()
121
+        EvKey (KChar '+') [] -> go vty (windowSucc clock)
122
+        EvKey (KChar '=') [] -> go vty (windowSucc clock)
123
+        EvKey (KChar '-') [] -> go vty (windowPred clock)
124
+        _                    -> go vty clock

+ 2
- 2
test/IndicatorTest.hs View File

@@ -32,8 +32,8 @@ segmentsTest =
32 32
     check digit table seg =
33 33
       assertBool ("Segment: " ++ show seg ++ " from " ++ show digit) $
34 34
         case lookup seg table of
35
-          Nothing -> not (indicator digit `testSegment` seg)
36
-          Just _  -> indicator digit `testSegment` seg
35
+          Nothing -> not (indicator digit `hasSeg` seg)
36
+          Just _  -> indicator digit `hasSeg` seg
37 37
 
38 38
     testCases :: [(Int, [Segment])]
39 39
     testCases = [ (0,  [A, B, C, D, E, F   ])

Loading…
Cancel
Save