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