scroll-1.20150313: Main.hs

import Control.Monad.ST
import Control.Monad.State.Strict
import UI.NCurses (Curses, screenSize, Event(..))
import Options.Applicative
import Data.Maybe

import Types
import Setup
import Control
import View
import Curses
import Rand
import Unicode
import Level
import qualified Level.File

data Opts = Opts
	{ fileOpt :: Maybe FilePath
	, randOpt :: Maybe String
	, timeoutOpt :: Maybe String
	}

parseOpts :: Parser Opts
parseOpts = Opts <$> optional pFileOpt <*> optional pRandOpt <*> optional pTimeoutOpt
  where
	pFileOpt = argument str $ 
		metavar "FILE" <>
		help "page a file"
	pRandOpt = strOption $
		short 'r' <>
		long "rand" <>
		metavar "RAND" <>
		help "RNG seed (0 for unshuffled levels)"
	pTimeoutOpt = strOption $
		short 't' <>
		long "timeout" <>
		metavar "TIMEOUT" <>
		help "quit if no keypress in this many seconds"

game :: ParserInfo Opts
game = info (helper <*> parseOpts)
	( fullDesc
	<> header "scroll - a roguelike pager" )

main :: IO ()
main = execParser game >>= setup

setup :: Opts -> IO ()
setup opts = do
	primeUnicodeTable
	rand <- initRand (randOpt opts)
	finalmsg <- inCurses $ \palette -> do
		level <- case fileOpt opts of
			Nothing -> levelFor rand 
				<$> Level.select palette timeoutms
			Just f -> liftIO $ Level.File.level rand f
		if emptyLevel (fst level)
			then return (Just "Game Over")
			else do
				(ymax, _) <- screenSize
				s <- liftIO $ stToIO $ makeWorld level ymax rand
				run s mainLoop EventResized palette timeoutms
					initialViewOffset
	maybe (return ()) putStrLn finalmsg
  where
	timeoutms = (* 1000) . read <$> timeoutOpt opts

run :: S -> Step -> Event -> Palette -> Maybe Integer -> ViewOffset -> Curses (Maybe String)
run s step input palette timeoutms offset = do
	(NextStep view n, s') <- liftIO $ stToIO $ flip runStateT s $
		step input
	(mevent, offset') <- displayView view palette timeoutms offset
	case mevent of
		Nothing -> return $ Just $ "Quitting due to " ++ show (fromMaybe 0 timeoutms `div` 1000) ++ " second idleness timeout"
		Just event -> maybe (return Nothing) (\a' -> run s' a' event palette timeoutms offset') n