scroll-1.20250228: 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 WorldSetup
import Control
import View
import Term
import Term.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 (InputEvent EventResized) palette timeoutms
					initialViewOffset
	maybe (return ()) putStrLn finalmsg
  where
	timeoutms = (* 1000) . read <$> timeoutOpt opts

run :: S -> Step -> InputEvent -> 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