scroll-1.20170122: Main.hs

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

import Types
import WorldSetup
import Control
import View
import Curses
import Rand
import Unicode
import Level
import qualified Level.File
import Pager

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 -> do
				pipedinput <- liftIO stdinPager
				case pipedinput of
					Nothing -> levelFor rand 
						<$> Level.select palette timeoutms
					Just s -> return $ 
						Level.File.level rand s
			Just f -> liftIO $ Level.File.level rand <$> readFile 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