scroll-1.20150313: Status.hs

module Status where

import Control.Monad
import Control.Monad.State.Strict
import Data.Char
import Data.Maybe
import qualified Data.Vector.Mutable as MV

import Types
import World
import Rand
import Player
import Utility.Percentage

-- The string will be truncated at the edge of the scroll.
stringAt :: Pos -> String -> M ()
stringAt (x, y) s = do
	w <- worldWidth
	h <- worldHeight
	unless (y >= h) $ do
		let maxsz = w - 3 - x
		let s' = take maxsz s
		forM_ [0..length s' - 1] $ \n -> do
			writeWorld (x + n, y) (s' !! n)

inEndCap :: Int -> String -> M ()
inEndCap x s = do
	pos <- inEndCap' x
	stringAt pos (map underline s)
   where
 	underline c
		| isSpace c = '_'
		| otherwise = c

inEndCap' :: Int -> M Pos
inEndCap' x = do
	y <- worldHeight
	return (x, y-1)

-- Shows a message in the scroll end cap.
showMessage :: String -> M ()
showMessage msg = modify $ \s -> s { messages = messages s ++ [msg] }

showRandomMessage :: [String] -> M ()
showRandomMessage = showMessage <=< randFrom

-- Shows a message in the scroll end cap. Only 1 message
-- can display at a time, and overly long messages will be truncated
-- to fit.
immediateMessage :: String -> M ()
immediateMessage msg = inEndCap 4 (msg ++ repeat ' ')

clearMessage :: M ()
clearMessage = showMessage ""

showMessages :: Maybe Step -> (Maybe Step -> M NextStep) -> M NextStep
showMessages cont call = do
	msgs <- gets messages
	if null msgs
		then continue
		else do
			modify $ \s -> s { messages = [] }
			msgloop msgs
  where
	continue = call cont
	msgloop [] = continue
	msgloop (m:ms) = do
		o <- hintOffset
		let (m', rest) = cutMessage m (o - 5 - morelen)
		let ms' = maybeToList rest ++ ms
		immediateMessage $ m' ++ if null ms' then "" else more
		if null ms'
			then continue
			else call $ Just $ const $ msgloop $ ms'
	more = " [More]"
	morelen = length more

cutMessage :: String -> Int -> (String, Maybe String)
cutMessage m sz = go [] sz (words m)
  where
	go c _ [] = (unwords (reverse c), Nothing)
	go c n (w:ws)
		| len < n = go (w:c) (n - len - if null c then 0 else 1) ws
		| null c =
			let (f, rag) = splitAt n w
			in (f, Just (unwords (rag:ws)))
		| otherwise = (unwords (reverse c), Just (unwords (w:ws)))
	  where
		len = length w

-- Displays stats (currently, only player depth percent), in
-- scroll end cap left side.
showStats :: M ()
showStats = do
	s <- get
	let (_, y) = playerHead $ player s
	let totallen = sum
		[ topBuffer s
		, MV.length $ world s
		, MV.length $ fst $ bottomBuffer s
		]
	let totaldown = y + topBuffer s
	let p = percentage (fromIntegral totallen) (fromIntegral totaldown)
	x <- statOffset
	inEndCap x (showPercentage p ++ "    ")

-- Updates the scroll end cap, right hand side, with a hint.
showHint :: M ()
showHint = do
	s <- get
	if helpShown s
		then do
			ok <- checkCanDive
			writeHint $ if ok then divehint else nohint
		else writeHint helphint
  where
	divehint = "d:dive"
	helphint = "?:help"
	nohint = replicate hlen '_'
	hlen = length divehint

hideHint :: M ()
hideHint = writeHint (replicate hintSz ' ')

writeHint :: String -> M ()
writeHint s = do
	x <- hintOffset
	inEndCap x s

hintSz :: Int
hintSz = length "d:dive"

hintOffset :: M Int
hintOffset = do
	x <- statOffset
	return $ x - hintSz - 2

statOffset :: M Int
statOffset = do
	w <- worldWidth
	return $ w - 4 - 2

showWindow :: Pos -> [String] -> M ()
showWindow p l = modify $ \s -> s { windows = w : (windows s) }
  where
	w = Window p (map sideborder (borderline : l ++ [borderline]))
	borderline = replicate width '#'
	sideborder s = "#" ++ s ++ replicate (width - length s) ' ' ++ "#"
	width = maximum (map length l)

clearWindows :: M ()
clearWindows = modify $ \s -> s { windows = [] }