1import Control.Monad.ST 2import Control.Monad.State.Strict 3import UI.NCurses (Curses, screenSize, Event(..)) 4import Options.Applicative 5import Data.Monoid ((<>)) 6import Data.Maybe 7 8import Types 9import WorldSetup 10import Control 11import View 12import Curses 13import Rand 14import Unicode 15import Level 16import qualified Level.File 17import Pager 18 19data Opts = Opts 20 { fileOpt :: Maybe FilePath 21 , randOpt :: Maybe String 22 , timeoutOpt :: Maybe String 23 } 24 25parseOpts :: Parser Opts 26parseOpts = Opts <$> optional pFileOpt <*> optional pRandOpt <*> optional pTimeoutOpt 27 where 28 pFileOpt = argument str $ 29 metavar "FILE" <> 30 help "page a file" 31 pRandOpt = strOption $ 32 short 'r' <> 33 long "rand" <> 34 metavar "RAND" <> 35 help "RNG seed (0 for unshuffled levels)" 36 pTimeoutOpt = strOption $ 37 short 't' <> 38 long "timeout" <> 39 metavar "TIMEOUT" <> 40 help "quit if no keypress in this many seconds" 41 42game :: ParserInfo Opts 43game = info (helper <*> parseOpts) 44 ( fullDesc 45 <> header "scroll - a roguelike pager" ) 46 47main :: IO () 48main = execParser game >>= setup 49 50setup :: Opts -> IO () 51setup opts = do 52 primeUnicodeTable 53 rand <- initRand (randOpt opts) 54 finalmsg <- inCurses $ \palette -> do 55 level <- case fileOpt opts of 56 Nothing -> do 57 pipedinput <- liftIO stdinPager 58 case pipedinput of 59 Nothing -> levelFor rand 60 <$> Level.select palette timeoutms 61 Just s -> return $ 62 Level.File.level rand s 63 Just f -> liftIO $ Level.File.level rand <$> readFile f 64 if emptyLevel (fst level) 65 then return (Just "Game Over") 66 else do 67 (ymax, _) <- screenSize 68 s <- liftIO $ stToIO $ makeWorld level ymax rand 69 run s mainLoop EventResized palette timeoutms 70 initialViewOffset 71 maybe (return ()) putStrLn finalmsg 72 where 73 timeoutms = (* 1000) . read <$> timeoutOpt opts 74 75run :: S -> Step -> Event -> Palette -> Maybe Integer -> ViewOffset -> Curses (Maybe String) 76run s step input palette timeoutms offset = do 77 (NextStep view n, s') <- liftIO $ stToIO $ flip runStateT s $ 78 step input 79 (mevent, offset') <- displayView view palette timeoutms offset 80 case mevent of 81 Nothing -> return $ Just $ "Quitting due to " ++ show (fromMaybe 0 timeoutms `div` 1000) ++ " second idleness timeout" 82 Just event -> maybe (return Nothing) (\a' -> run s' a' event palette timeoutms offset') n 83