update display on tenths of seconds

1 files changed, 23 insertions, 18 deletions

diff --git a/countdown.hs b/countdown.hs
index a7d1377..7c510b5 100755
--- a/countdown.hs
+++ b/countdown.hs
@@ -112,19 +112,14 @@ yearEnd (LocalTime d _) = LocalTime d' t'
 dayNumOfYear :: LocalTime -> Int
 dayNumOfYear = snd . toOrdinalDate . localDay
 
-pluralize :: Integral i => i -> String
+pluralize :: (Num n, Eq n) => n -> String
 pluralize 1 = ""
 pluralize _ = "s"
 
-pluralizeVerb :: Integral i => i -> String
+pluralizeVerb :: (Num n, Eq n) => n -> String
 pluralizeVerb 1 = "s"
 pluralizeVerb _ = ""
 
-truncateTime :: LocalTime -> LocalTime
-truncateTime (LocalTime d (TimeOfDay h m s)) = (LocalTime d (TimeOfDay h m s'))
-  where
-    s' = fromIntegral (floor s :: Int)
-
 drawUI :: St -> [Widget ()]
 drawUI st = [a]
   where
@@ -184,7 +179,7 @@ showLarge n | n >= 10                      = unpack $ commasF 0 n
 showLarge n                                = printf "%.3f" n
 
 countdownWidget :: Bool -> LocalTime -> Widget n
-countdownWidget isSimulated (truncateTime -> t) =
+countdownWidget isSimulated t =
   (hCenter (borderWithLabel (str $ printf "Current time%s" (if isSimulated then " (SIMULATED)" else "")) $
             padLeftRight 3 $ (str (formatTime defaultTimeLocale "%A, %B %e%n%Y-%m-%d %r" t))))
 
@@ -202,7 +197,7 @@ countdownWidget isSimulated (truncateTime -> t) =
                         (commasF 2 minutesLeft)
                         (pluralize $ (floor minutesLeft :: Integer))
                         (pluralizeVerb $ (floor minutesLeft :: Integer))
-                        (commas secondsLeft)
+                        (commasF 1 secondsLeft)
                         (pluralize secondsLeft)
                         (pluralizeVerb secondsLeft)))
      , (borderWithLabel (str "Cosmic Time") $
@@ -253,9 +248,9 @@ countdownWidget isSimulated (truncateTime -> t) =
 
     daysLeft       = numDays - dayNum
     hoursLeft      = minutesLeft / 60
-    minutesLeft    = (fromIntegral secondsLeft) / 60 :: Double
-    secondsLeft    = toSeconds $ yearLength - yearElapsed :: Int
+    minutesLeft    = fromRational $ toRational secondsLeft / 60 :: Double
     toSeconds      = floor . nominalDiffTimeToSeconds
+    secondsLeft    = nominalDiffTimeToSeconds (yearLength - yearElapsed)
     x // y         = fromRational $ toRational x / toRational y :: Double
     progressLabel  = printf "%.6F%%" (100 * (yearElapsed // yearLength))
 
@@ -267,6 +262,11 @@ commasF precision = prettyF cfg
 commas :: Integral i => i -> Text
 commas = prettyI (Just ',') . fromIntegral
 
+nextTenthOfSecond :: ZonedTime -> ZonedTime
+nextTenthOfSecond (ZonedTime (LocalTime day (TimeOfDay h m s)) z) = (ZonedTime (LocalTime day (TimeOfDay h m s')) z)
+  where
+    s' = fromRational $ toRational (floor (s * 10) + 1 :: Integer) / 10
+
 nextWholeSecond :: ZonedTime -> ZonedTime
 nextWholeSecond (ZonedTime (LocalTime day (TimeOfDay h m s)) z) = (ZonedTime (LocalTime day (TimeOfDay h m s')) z)
   where
@@ -275,12 +275,16 @@ nextWholeSecond (ZonedTime (LocalTime day (TimeOfDay h m s)) z) = (ZonedTime (Lo
 diffZonedTime :: ZonedTime -> ZonedTime -> NominalDiffTime
 diffZonedTime = diffLocalTime `Prelude.on` zonedTimeToLocalTime
 
-queueNextEvent :: MonadIO m => BChan CustomEvent -> m ZonedTime
-queueNextEvent chan = liftIO $ do
+isNewYearsEve t = dayNumOfYear t == daysInYear t
+
+queueNextEvent :: MonadIO m => Bool -> BChan CustomEvent -> m ZonedTime
+queueNextEvent hyper chan = liftIO $ do
   now <- getZonedTime
   void . forkIO $ do
-    let next = nextWholeSecond now
-    let delay = next `diffZonedTime` now
+
+    let getNext = if hyper then nextTenthOfSecond else nextWholeSecond
+        next = getNext now
+        delay = next `diffZonedTime` now
     threadDelay $ floor $ delay * 1000 * 1000
     writeBChan chan $ TimeChanged next
   return now
@@ -310,10 +314,11 @@ handleEvent chan st e =
         VtyEvent (V.EvKey (V.KChar 'p') [])  -> cont $ st & stPaused %~ not
         VtyEvent _                           -> cont st
         AppEvent (TimeChanged now) -> do
-          void $ queueNextEvent chan
+          let hyper = isNewYearsEve $ st ^. stDisplayTime
+          void $ queueNextEvent hyper chan
           let oldTime = st ^. stClockTime
           cont $ st & stClockTime .~ (zonedTimeToLocalTime now)
-                    & stDisplayTime %~ if st ^. stPaused then id else (addLocalTime ((zonedTimeToLocalTime now) `diffLocalTime` oldTime))
+                    & stDisplayTime %~ if st ^. stPaused then id else addLocalTime $ zonedTimeToLocalTime now `diffLocalTime` oldTime
         _ -> cont st
     where
       cont s = do
@@ -386,5 +391,5 @@ main = do
 
     let buildVty = V.mkVty V.defaultConfig
     initialVty <- buildVty
-    now <- queueNextEvent chan
+    now <- queueNextEvent False chan
     void $ customMain initialVty buildVty (Just chan) (theApp chan) (initialState $ zonedTimeToLocalTime now)