implement calendar-entry-based time warping

2 files changed, 19 insertions, 6 deletions

diff --git a/CosmicCalendar.hs b/CosmicCalendar.hs
index 8def5b7..290fa3a 100644
--- a/CosmicCalendar.hs
+++ b/CosmicCalendar.hs
@@ -93,8 +93,11 @@ yearStart (LocalTime d _) = LocalTime d' t'
 localTimeToYearElapsed :: LocalTime -> NominalDiffTime
 localTimeToYearElapsed t = t `diffLocalTime` yearStart t
 
-getLastCalendarEntry :: LocalTime -> Maybe CalendarEntry
-getLastCalendarEntry (localTimeToYearElapsed -> t) = snd <$> Map.lookupLE t theCalendar
+getPreviousCalendarEntry :: LocalTime -> Maybe CalendarEntry
+getPreviousCalendarEntry (localTimeToYearElapsed -> t) = snd <$> Map.lookupLT t theCalendar
+
+getCurrentCalendarEntry :: LocalTime -> Maybe CalendarEntry
+getCurrentCalendarEntry (localTimeToYearElapsed -> t) = snd <$> Map.lookupLE t theCalendar
 
 getNextCalendarEntry :: LocalTime -> Maybe CalendarEntry
 getNextCalendarEntry (localTimeToYearElapsed -> t) = snd <$> Map.lookupGT t theCalendar
diff --git a/countdown.hs b/countdown.hs
index d630287..42675f6 100755
--- a/countdown.hs
+++ b/countdown.hs
@@ -210,15 +210,15 @@ countdownWidget isSimulated t =
     str "\n"
     <=>
     hCenter (hBox [
-                vBox [ cosmicCalendarNext, str "\n", cosmicCalendarPrevious ],
+                vBox [ cosmicCalendarCurrent, txt "\n", cosmicCalendarNext ],
                 str "   ",
                 borderWithLabel (str "Cosmic Conversion") (hBox [cosmicConversion, cosmicConversion'])
     ])
   where
-    cosmicCalendarPrevious = borderWithLabel (str "Previously on the Cosmic Calendar") prevEntry
-    cosmicCalendarNext = borderWithLabel (str $ (if current then "Now" else "Next") ++ " on the Cosmic Calendar") nextEntry
+    cosmicCalendarCurrent = borderWithLabel (str $ (if current then "Now" else "Previously") ++ " on the Cosmic Calendar") currentEntry
       where
         current = True
+    cosmicCalendarNext = borderWithLabel (txt "Next on the Cosmic Calendar") nextEntry
 
     -- TODO: We want to display "today" or "now" on the cosmic calendar;
     -- We want to display what happened previously on the cosmic calendar
@@ -228,7 +228,7 @@ countdownWidget isSimulated t =
     -- We also _may_ want to say the same thing for the current happening, depending on if it's an instant or a stage
     -- If it's a stage, we want to say how long it lasts; how long since it started, and how long until it ends
 
-    prevEntry = fromMaybe (str "none") $ calendarWidget <$> getLastCalendarEntry t
+    currentEntry = fromMaybe (str "none") $ calendarWidget <$> getCurrentCalendarEntry t
     nextEntry = fromMaybe (str "none") $ calendarWidget <$> getNextCalendarEntry t
 
     calendarWidget CalendarEntry{..} = vBox [eventCountdown, str "\n", box]
@@ -371,6 +371,14 @@ queueNextEvent hyper chan = liftIO $ do
 isSimulatedTime :: St -> Bool
 isSimulatedTime st = st ^. stDisplayTime /= st ^. stClockTime
 
+nextCalendarEntryTime :: LocalTime -> LocalTime
+nextCalendarEntryTime t = fromMaybe t $ getNextCalendarEntry t <&> (`addLocalTime` yearStart t) . calBeginTime
+
+previousCalendarEntryTime :: LocalTime -> LocalTime
+previousCalendarEntryTime t = fromMaybe t $ goBack t
+  where
+    goBack t = getPreviousCalendarEntry t <&> (`addLocalTime` yearStart t) . calBeginTime
+
 handleEvent :: BChan CustomEvent -> St -> BrickEvent () CustomEvent -> EventM () (Next St)
 handleEvent chan st e =
     case e of
@@ -391,6 +399,8 @@ handleEvent chan st e =
         VtyEvent (V.EvKey V.KEnd [MShift])   -> cont $ st & stDisplayTime .~ (yearEnd $ st ^. stClockTime)
         VtyEvent (V.EvKey V.KEnd [MCtrl])    -> cont $ st & stDisplayTime .~ (newYearsEveNoon $ st ^. stClockTime)
         VtyEvent (V.EvKey (V.KChar 'p') [])  -> cont $ st & stPaused %~ not
+        VtyEvent (V.EvKey (V.KChar ',') [])  -> cont $ st & stDisplayTime %~ previousCalendarEntryTime
+        VtyEvent (V.EvKey (V.KChar '.') [])  -> cont $ st & stDisplayTime %~ nextCalendarEntryTime
         VtyEvent _                           -> cont st
         AppEvent (TimeChanged now) -> do
           let hyper = isNewYearsEve $ st ^. stDisplayTime