Last active
August 29, 2015 14:11
-
-
Save mitsuji/bd667abfd11b2be45612 to your computer and use it in GitHub Desktop.
non-FRP stop-watch
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module StopWatch where | |
import System.IO | |
import Control.Monad (when) | |
import Control.Concurrent.Timer | |
import Control.Concurrent.Suspend | |
import Data.Time.Clock | |
import Data.IORef | |
main :: IO () | |
main = do | |
displayHelpMessage | |
timer <- newTimer | |
stateRef <- newIORef (False, TimeCount 0) | |
waitCommand timer stateRef | |
displayHelpMessage :: IO () | |
displayHelpMessage = mapM_ putStrLn $ | |
"Commands are:": | |
" s - start/stop ": | |
" l - record lap time": | |
" q - quit the program": | |
"": | |
[] | |
type StateRef = IORef (Bool, TimeCount) | |
waitCommand :: TimerIO -> StateRef -> IO () | |
waitCommand timer stateRef = do | |
hSetEcho stdin False | |
hSetBuffering stdin NoBuffering | |
s <- getChar | |
case s of | |
's' -> do | |
isRunning <- readIsRunning stateRef | |
if isRunning | |
then stop timer stateRef | |
else start timer stateRef | |
'l' -> lap' timer stateRef | |
'q' -> return () | |
_ -> do | |
putStrLn $ [s] ++ " - unknown command" | |
waitCommand timer stateRef | |
start :: TimerIO -> StateRef -> IO () | |
start timer stateRef = do | |
timeCurr <- getCurrentTime | |
timeCount <- readTimeCount stateRef | |
success <- repeatedStart timer (tick' timeCurr timeCount) $ msDelay 10 | |
-- [TODO] check success | |
writeIsRunning stateRef True | |
waitCommand timer stateRef | |
where | |
tick' timeStart timeCount = do | |
timeCurr <- getCurrentTime | |
let newTimeCount = TimeCount $ (diffUTCTime timeCurr timeStart) + (getDiffTime timeCount) | |
tick $ newTimeCount | |
writeTimeCount stateRef $ newTimeCount | |
stop :: TimerIO -> StateRef -> IO () | |
stop timer stateRef = do | |
stopTimer timer | |
writeIsRunning stateRef False | |
waitCommand timer stateRef | |
lap' :: TimerIO -> StateRef -> IO () | |
lap' timer stateRef = do | |
timeCount <- readTimeCount stateRef | |
lap timeCount | |
waitCommand timer stateRef | |
readIsRunning :: StateRef -> IO Bool | |
readIsRunning stateRef = do | |
(isRunning, _) <- readIORef stateRef | |
return isRunning | |
readTimeCount :: StateRef -> IO TimeCount | |
readTimeCount stateRef = do | |
(_, timeCount) <- readIORef stateRef | |
return timeCount | |
writeIsRunning :: StateRef -> Bool -> IO () | |
writeIsRunning stateRef isRunning = do | |
(_, timeCount) <- readIORef stateRef | |
writeIORef stateRef (isRunning, timeCount) | |
writeTimeCount :: StateRef -> TimeCount -> IO () | |
writeTimeCount stateRef timeCount = do | |
(isRunning, _) <- readIORef stateRef | |
writeIORef stateRef (isRunning, timeCount) | |
tick :: TimeCount -> IO () | |
lap :: TimeCount -> IO () | |
tick timeCount = (putChar '\r') >> ( putStr $ show $ timeCount ) | |
lap timeCount = (putChar '\n') >> ( putStr $ show $ timeCount ) | |
-- | |
-- TimeCount for stop-watch counter | |
-- | |
-- | |
-- | |
newtype TimeCount = TimeCount { getDiffTime::NominalDiffTime } | |
instance Show TimeCount where | |
show tc = hour ++ ":" ++ min ++ ":" ++ sec ++ "." ++ ms | |
where | |
dt = getDiffTime tc | |
hour = show $ truncate (dt / 3600) | |
min = fixed 2 $ mod ( truncate (dt / 60 ) ) 60 | |
sec = fixed 2 $ mod ( truncate (dt ) ) 60 | |
ms = fixed 3 $ mod ( truncate (dt * 1000) ) 1000 | |
fixed :: Int -> Int -> String | |
fixed digits num = replicate ( digits - len ) '0' ++ num' | |
where | |
num' = show num | |
len = length $ num' | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment