Browse Source

Sloppy multi-window support with a Stack type

master
Peter J. Jones 4 years ago
parent
commit
f17ed4a7cd

+ 6
- 1
clockdown.cabal View File

@@ -26,13 +26,17 @@ flag maintainer
--------------------------------------------------------------------------------
library
exposed-modules:
-- Clockdown.UI.Common.Binding
Clockdown.Core.Clock
Clockdown.Core.Clockdown
Clockdown.Core.Countdown
Clockdown.Core.Digital.Display
Clockdown.Core.Digital.Indicator
Clockdown.Core.Properties
Clockdown.Core.Stack
Clockdown.Core.Window
Clockdown.UI.Common.Action
Clockdown.UI.Common.Binding
Clockdown.UI.Common.Dispatch
Clockdown.UI.Term.Draw
Clockdown.UI.Term.Run

@@ -47,6 +51,7 @@ library
build-depends: async >= 2.0 && < 2.1
, base >= 4.7 && < 5.0
, containers >= 0.5 && < 0.6
, mtl >= 2.2 && < 2.3
, text >= 0.11 && < 1.3
, time >= 1.5 && < 1.6
, vty >= 5.2 && < 5.3

+ 6
- 6
src/Clockdown/Core/Clock.hs View File

@@ -13,8 +13,8 @@ the LICENSE file.
module Clockdown.Core.Clock
( Clock (..)
, clockDigitalDisplay
, clockForward
, clockBackward
, clockSucc
, clockPred
) where

--------------------------------------------------------------------------------
@@ -39,13 +39,13 @@ clockDigitalDisplay c t = Digital.digitalClock (localTimeOfDay time)

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

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

--------------------------------------------------------------------------------
-- | Helper function to alter a clock's time zone.

+ 40
- 0
src/Clockdown/Core/Clockdown.hs View File

@@ -0,0 +1,40 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-

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.Clockdown
( Clockdown
, ask
, get
, put
, liftIO
, runClockdown
) where

--------------------------------------------------------------------------------
import Control.Monad.RWS

--------------------------------------------------------------------------------
import Clockdown.Core.Stack
import Clockdown.Core.Window

--------------------------------------------------------------------------------
newtype Clockdown r m a = Clockdown {unC :: RWST r () (Stack Window) m a}
deriving ( Functor, Applicative, Monad, MonadIO
, MonadReader r, MonadState (Stack Window)
)

--------------------------------------------------------------------------------
runClockdown :: (Monad m) => r -> Stack Window -> Clockdown r m a -> m a
runClockdown r s c = do (a, _, _) <- runRWST (unC c) r s
return a

+ 48
- 0
src/Clockdown/Core/Countdown.hs View File

@@ -0,0 +1,48 @@
{-

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.Countdown
( Countdown (..)
, countDownDigitalDisplay
, countDownSucc
, countDownPred
) where

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

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

--------------------------------------------------------------------------------
data Countdown = Countdown
{ countProps :: Properties
, countEnd :: UTCTime
}

--------------------------------------------------------------------------------
countDownDigitalDisplay :: Countdown -> UTCTime -> Digital.Display
countDownDigitalDisplay c t = Digital.digitalCountDown secs
where secs = max 0 (truncate $ diffUTCTime (countEnd c) t)

--------------------------------------------------------------------------------
-- | Move a countdown forward one minute.
countDownSucc :: Countdown -> Countdown
countDownSucc = undefined

--------------------------------------------------------------------------------
-- | Move a countdown backward one minute.
countDownPred :: Countdown -> Countdown
countDownPred = undefined

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

@@ -14,7 +14,7 @@ the LICENSE file.
module Clockdown.Core.Digital.Display
( Display (..)
, digitalClock
, countDown
, digitalCountDown
) where

--------------------------------------------------------------------------------
@@ -45,8 +45,8 @@ digitalClock t = display (todHour t) (todMin t)
-- count down timer. When there are more than sixth minutes remaining
-- the display will show hours and minutes. Otherwise it will show
-- minutes and seconds.
countDown :: Int -> Display
countDown n = if hh > 0 then display hh mm else display mm ss
digitalCountDown :: Int -> Display
digitalCountDown n = if hh > 0 then display hh mm else display mm ss
where
hh = n `div` 3600
mm = (n `div` 60) - (hh * 60)

+ 75
- 0
src/Clockdown/Core/Stack.hs View File

@@ -0,0 +1,75 @@
{-

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.Stack
( Stack
, stack
, push
, pop
, head
, rotateLeft
, rotateRight
) where

--------------------------------------------------------------------------------
import Prelude hiding (head)

--------------------------------------------------------------------------------
-- | A stack that can't be empty.
data Stack a = Node a | List a (Stack a)

--------------------------------------------------------------------------------
instance Functor Stack where
fmap f (Node x) = Node (f x)
fmap f (List x xs) = List (f x) (fmap f xs)

--------------------------------------------------------------------------------
stack :: a -> Stack a
stack = Node

--------------------------------------------------------------------------------
push :: a -> Stack a -> Stack a
push x (Node y) = List x (Node y)
push x (List y ys) = List x (List y ys)

--------------------------------------------------------------------------------
pop :: Stack a -> (a, Stack a)
pop (Node x) = (x, Node x)
pop (List x xs) = (x, xs)

--------------------------------------------------------------------------------
rpush :: a -> Stack a -> Stack a
rpush x (Node y) = List y (Node x)
rpush x (List y ys) = List y (rpush x ys)

--------------------------------------------------------------------------------
rpop :: Stack a -> (a, Stack a)
rpop (Node x) = (x, Node x)
rpop (List x (Node y)) = (y, Node x)
rpop (List x xs) = let (y, ys) = rpop xs in (y, List x ys)

--------------------------------------------------------------------------------
head :: Stack a -> a
head (Node x) = x
head (List x _) = x

--------------------------------------------------------------------------------
rotateLeft :: Stack a -> Stack a
rotateLeft (Node x) = Node x
rotateLeft (List x (Node y)) = List y (Node x)
rotateLeft (List x xs) = List (head xs) (rpush x . snd $ pop xs)

--------------------------------------------------------------------------------
rotateRight :: Stack a -> Stack a
rotateRight (Node x) = Node x
rotateRight (List x (Node y)) = List y (Node x)
rotateRight (List x xs) = let (z, zs) = rpop xs in List z (List x zs)

+ 17
- 5
src/Clockdown/Core/Window.hs View File

@@ -11,8 +11,9 @@ the LICENSE file.

--------------------------------------------------------------------------------
module Clockdown.Core.Window
( Window
( Window (..)
, makeClock
, windowTick
, windowDigitalDisplay
, windowProperties
, windowSucc
@@ -26,6 +27,7 @@ import Data.Time
--------------------------------------------------------------------------------
-- Local imports:
import Clockdown.Core.Clock
import Clockdown.Core.Countdown
import qualified Clockdown.Core.Digital.Display as Digital
import Clockdown.Core.Properties

@@ -33,27 +35,37 @@ import Clockdown.Core.Properties
-- | A type to hold the information about what should be displayed in
-- a window.
data Window = ClockWin Clock
| CountdownWin Countdown

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

--------------------------------------------------------------------------------
windowTick :: UTCTime -> Window -> Window
windowTick _ (ClockWin c) = ClockWin c -- No ticking necessary.
windowTick _ (CountdownWin c) = CountdownWin c -- FIXME:

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

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

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

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

+ 7
- 1
src/Clockdown/UI/Common/Action.hs View File

@@ -20,14 +20,20 @@ module Clockdown.UI.Common.Action
import Data.Text (Text)
import Data.Time

--------------------------------------------------------------------------------
-- Local imports:
import Clockdown.Core.Window

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

| NewWindow Window
-- ^ Add a window to the end of the window list.

| Quit
-- ^ Quit the application.
deriving (Show, Read)

--------------------------------------------------------------------------------
parseAction :: Text -> Either String Action

+ 45
- 0
src/Clockdown/UI/Common/Dispatch.hs View File

@@ -0,0 +1,45 @@
{-

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.Dispatch
( dispatch
) where

--------------------------------------------------------------------------------
-- Library imports:
import Data.Time (UTCTime)

--------------------------------------------------------------------------------
-- Local imports:
import Clockdown.Core.Clockdown
import qualified Clockdown.Core.Stack as S
import Clockdown.Core.Window
import Clockdown.UI.Common.Action

--------------------------------------------------------------------------------
dispatch :: (Monad m) => Action -> Clockdown r m (Maybe UTCTime, Window)
dispatch a = do
windows <- get

case a of
Tick t -> do
-- Update all windows, then return the main window.
let windows' = fmap (windowTick t) windows
put windows'
return (Just t, S.head windows')

NewWindow w -> do
let windows' = S.push w windows
put windows'
return (Nothing, w)

Quit -> return (Nothing, S.head windows)

+ 26
- 15
src/Clockdown/UI/Term/Run.hs View File

@@ -26,9 +26,13 @@ import Graphics.Vty

--------------------------------------------------------------------------------
-- Local imports:
import Clockdown.Core.Clockdown
import Clockdown.Core.Countdown
import Clockdown.Core.Properties
import qualified Clockdown.Core.Stack as S
import Clockdown.Core.Window
import Clockdown.UI.Common.Action
import Clockdown.UI.Common.Dispatch
import Clockdown.UI.Term.Draw

--------------------------------------------------------------------------------
@@ -39,18 +43,16 @@ tickThread channel = forever $ do
threadDelay 1000000

--------------------------------------------------------------------------------
drawThread :: Vty -> Chan Action -> IO ()
drawThread vty channel = forever $ do
tz <- getCurrentTimeZone
action <- readChan channel
drawThread :: Vty -> S.Stack Window -> Chan Action -> IO ()
drawThread vty wins channel = runClockdown vty wins $ forever $ do
action <- liftIO (readChan channel)
(mtick, window) <- dispatch action
tick <- maybe (liftIO getCurrentTime) return mtick
liftIO (draw $ windowDigitalDisplay window tick)

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)
Quit -> return ()
where draw d = do
region <- displayBounds (outputIface vty)
update vty $ picForImage (centerImage region $ drawDisplay d)

--------------------------------------------------------------------------------
-- | Temporary function for testing the drawing functions.
@@ -60,16 +62,25 @@ run = do
vty <- mkVty cfg
channel <- newChan
ticker <- async (tickThread channel)
tz <- getCurrentTimeZone

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

where
go vty = do
wins tz = S.stack (makeClock (Properties "foo") tz)

go chan vty = do
e <- nextEvent vty

case e of
EvKey KEsc [] -> return ()
_ -> go vty
EvKey (KChar '1') [] -> do
now <- getCurrentTime
let end = addUTCTime 90 now
let w = CountdownWin $ Countdown (Properties "foo") end
writeChan chan (NewWindow w)
go chan vty
_ -> go chan vty

Loading…
Cancel
Save