Timers for use with probabilistic focus and without

1 files changed, 24 insertions, 1 deletions

diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs
index fbf3c7d..bb29b86 100644
--- a/src/Sequence/Utils.hs
+++ b/src/Sequence/Utils.hs
@@ -1,10 +1,12 @@
 {-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, OverloadedStrings, OverloadedLists, RankNTypes #-}
 
 module Sequence.Utils
-  ( withArg, withFocus, withFocus'
+  ( TimerLength(..), TimerOrigin(..)
+  , withArg, withFocus, withFocus'
   , focusState
   , toName, toDesc
   , outputLogged
+  , scaleTimer
   , Argument(..)
   , Completion(..)
   , module Sequence.Utils.Ask
@@ -50,6 +52,10 @@ import Sequence.Formula
 
 import Text.Regex (mkRegex, subRegex)
 
+data TimerLength = TimerLength TimerOrigin Int
+
+data TimerOrigin = Absolute | Now
+
 class Argument a st | a -> st where
   arg :: String -> Sh st (Maybe a)
 
@@ -93,6 +99,23 @@ outputLogged id str = gLog <>= pure (id, clean str) >> shellPutStrLn str
   where
     clean str = subRegex (mkRegex "(\x9B|\x1B\\[)[0-?]*[ -/]*[@-~]") str "" -- remove ANSI escapes
 
+scaleTimer :: Int -> Rational -> Timer -> Timer
+scaleTimer _ _ t@(Constant _) = t
+scaleTimer (fromIntegral -> now) factor (Scaled r) = Scaled $ ((max 0 $ r - now) * factor) + now
+
+instance Completion TimerLength GameState where
+  completableLabel _ = "<timer offset>"
+  complete _ st prefix = return []
+
+instance Argument TimerLength GameState where
+  arg str
+    | ('+':cs) <- str
+    , (Just n) <- readMaybe cs
+    , n >= 0 = return . Just $ TimerLength Now n
+    | (Just n) <- readMaybe str
+    , n >= 0 = return . Just $ TimerLength Absolute n
+    | otherwise = return Nothing
+
 instance Completion EntityIdentifier GameState where
   completableLabel _ = "<entity>"
   complete _ st prefix = return . filter ((isPrefixOf `on` CI.foldCase) prefix) . map ((evalState ?? st) . toName) . Map.keys $ st ^. gEntities