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 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