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