scroll-1.20150313: Time.hs

module Time where

import Control.Monad.State.Strict

import Types
import Status
import View

next :: Step -> M NextStep
next = nextStep . Just

nextStep :: Maybe Step -> M NextStep
nextStep cont = showMessages cont nextStep'

nextStep' :: Maybe Step -> M NextStep
nextStep' a = do
	showHint
	showStats
	view <- lift . mkView =<< get
	return $ NextStep view a

prompt :: String -> Step -> M NextStep
prompt p a = do
	showHint
	showStats
	immediateMessage p
	nextStep' (Just a)

-- Fork off a long duration job as a separate thread.
--
-- The background job is the first parameter; second is the main
-- thread. The difference between the two is that when the job
-- finishes, the program doesn't quit.
--
-- The job always runs before the main thread.
fork :: M NextStep -> M NextStep -> M NextStep
fork job rest = do
	jn <- job
	rn <- rest
	runthread jn rn
  where
	runthread (NextStep _ (Just contjob)) (NextStep v (Just contr)) =
		return $ NextStep v $ Just $ \i -> do
			jn <- contjob i
			rn <- contr i
			runthread jn rn
	runthread (NextStep _ Nothing) (NextStep v (Just contr)) =
		return $ NextStep v (Just contr)
	runthread _ (NextStep v Nothing) =
		return $ NextStep v Nothing

-- If called in the main thread, program exits.
endThread :: M NextStep
endThread = nextStep Nothing

-- Starts a thread that waits the specified number of ticks,
-- and then runs the action.
delayAction :: Int -> M NextStep -> M () -> M NextStep
delayAction n cont a = fork (delayAction' n a) cont

delayAction' :: Int -> M () -> M NextStep
delayAction' 0 a = a >> endThread
delayAction' n a = next $ \_ -> delayAction' (pred n) a