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