1module Status where
2
3import Control.Monad
4import Control.Monad.State.Strict
5import Data.Char
6import Data.Maybe
7import qualified Data.Vector.Mutable as MV
8
9import Types
10import World
11import Rand
12import Player
13import Utility.Percentage
14
15-- The string will be truncated at the edge of the scroll.
16stringAt :: Pos -> String -> M ()
17stringAt (x, y) s = do
18	w <- worldWidth
19	h <- worldHeight
20	unless (y >= h || y < 0 || x < 0) $ do
21		let maxsz = w - 3 - x
22		let s' = take maxsz s
23		forM_ [0..length s' - 1] $ \n -> do
24			writeWorld (x + n, y) (s' !! n)
25
26inEndCap :: Int -> String -> M ()
27inEndCap x s = do
28	pos <- inEndCap' x
29	stringAt pos (map underline s)
30   where
31 	underline c
32		| isSpace c = '_'
33		| otherwise = c
34
35inEndCap' :: Int -> M Pos
36inEndCap' x = do
37	y <- worldHeight
38	return (x, y-1)
39
40-- Shows a message in the scroll end cap.
41showMessage :: String -> M ()
42showMessage msg = modify $ \s -> s { messages = messages s ++ [msg] }
43
44showRandomMessage :: [String] -> M ()
45showRandomMessage = showMessage <=< randFrom
46
47-- Shows a message in the scroll end cap. Only 1 message
48-- can display at a time, and overly long messages will be truncated
49-- to fit.
50immediateMessage :: String -> M ()
51immediateMessage msg = inEndCap 4 (msg ++ repeat ' ')
52
53clearMessage :: M ()
54clearMessage = showMessage ""
55
56showMessages :: Maybe Step -> (Maybe Step -> M NextStep) -> M NextStep
57showMessages cont call = do
58	msgs <- gets messages
59	if null msgs
60		then continue
61		else do
62			modify $ \s -> s { messages = [] }
63			msgloop msgs
64  where
65	continue = call cont
66	msgloop [] = continue
67	msgloop (m:ms) = do
68		o <- hintOffset
69		let (m', rest) = cutMessage m (o - 5 - morelen)
70		let ms' = maybeToList rest ++ ms
71		immediateMessage $ m' ++ if null ms' then "" else more
72		if null ms'
73			then continue
74			else call $ Just $ const $ msgloop $ ms'
75	more = " [More]"
76	morelen = length more
77
78cutMessage :: String -> Int -> (String, Maybe String)
79cutMessage m sz = go [] sz (words m)
80  where
81	go c _ [] = (unwords (reverse c), Nothing)
82	go c n (w:ws)
83		| len < n = go (w:c) (n - len - if null c then 0 else 1) ws
84		| null c =
85			let (f, rag) = splitAt n w
86			in (f, Just (unwords (rag:ws)))
87		| otherwise = (unwords (reverse c), Just (unwords (w:ws)))
88	  where
89		len = length w
90
91-- Displays stats (currently, only player depth percent), in
92-- scroll end cap left side.
93showStats :: M ()
94showStats = do
95	s <- get
96	let (_, y) = playerHead $ player s
97	let totallen = sum
98		[ topBuffer s
99		, MV.length $ world s
100		, MV.length $ fst $ bottomBuffer s
101		]
102	let totaldown = y + topBuffer s
103	let p = percentage (fromIntegral totallen) (fromIntegral totaldown)
104	x <- statOffset
105	inEndCap x (showPercentage p ++ "    ")
106
107-- Updates the scroll end cap, right hand side, with a hint.
108showHint :: M ()
109showHint = do
110	s <- get
111	if helpShown s
112		then do
113			ok <- checkCanDive
114			writeHint $ if ok then divehint else nohint
115		else writeHint helphint
116  where
117	divehint = "d:dive"
118	helphint = "?:help"
119	nohint = replicate hlen '_'
120	hlen = length divehint
121
122hideHint :: M ()
123hideHint = writeHint (replicate hintSz ' ')
124
125writeHint :: String -> M ()
126writeHint s = do
127	x <- hintOffset
128	inEndCap x s
129
130hintSz :: Int
131hintSz = length "d:dive"
132
133hintOffset :: M Int
134hintOffset = do
135	x <- statOffset
136	return $ x - hintSz - 2
137
138statOffset :: M Int
139statOffset = do
140	w <- worldWidth
141	return $ w - 4 - 2
142
143showWindow :: Pos -> [String] -> M ()
144showWindow p l = modify $ \s -> s { windows = w : (windows s) }
145  where
146	w = Window p (map sideborder (borderline : l ++ [borderline]))
147	borderline = replicate width '#'
148	sideborder s = "#" ++ s ++ replicate (width - length s) ' ' ++ "#"
149	width = maximum (map length l)
150
151clearWindows :: M ()
152clearWindows = modify $ \s -> s { windows = [] }
153