module Text.Chatty.Typograph where
import Control.Monad
import Control.Monad.Trans.Class
import Data.Char
import Data.List
import Text.Chatty.Interactor
import Text.Chatty.Printer
import Text.Chatty.Scanner
import Text.Chatty.Scanner.Buffered
simpleTypesetter :: (Functor m,ChScanner m,ChPrinter m) => Int -> m ()
simpleTypesetter width = void $ runScannerBufferT (typeset width) [""]
where scanw = mscannable >>= \b -> if not b then return [] else do
k <- mpeek1
if isSpace k then return [] else do
mscan1
ks <- scanw
return (k:ks)
skipw :: ChBufferedScanner m => m Int
skipw = mscannable >>= \b -> if not b then return 0 else do
k <- mpeek1
if not (isSpace k) then return 0 else do
mscan1
w <- skipw
return (w + if k == '\n' then 1 else 0)
tsetw i w
| length w < i = mprint (w ++ " ") >> typeset (i 1 length w)
| length w == i = mprintLn w >> typeset width
| length w > width && i == width = mprintLn (take i w) >> tsetw width (drop i w)
| otherwise = mprintLn "" >> tsetw width w
typeset i = mscannable >>= \b -> when b $ do
ls <- skipw
if ls > 0
then forM_ [1..ls] (const $ mprintLn "") >> typeset width
else do
w <- scanw
tsetw i w
leftTypesetter :: (Functor m,ChScanner m,ChPrinter m) => Int -> (String -> [String]) -> m ()
leftTypesetter width hyphen = void $ runScannerBufferT paragraphs [""]
where scanw :: ChBufferedScanner m => m String
scanw = mscannable >>= \b -> if not b then return [] else do
k <- mpeek1
if isSpace k then return [] else do
mscan1
ks <- scanw
return (k:ks)
skipw :: ChBufferedScanner m => m Int
skipw = mscannable >>= \b -> if not b then return 0 else do
k <- mpeek1
if not (isSpace k) then return 0 else do
mscan1
w <- skipw
return (w + if k == '\n' then 1 else 0)
combis [] [] = []
combis w (a:as) = (w,concat (a:as)) : combis (w++a) as
tsetw :: Int -> String -> [(String,Int,Int)]
tsetw i w = do
a <- [("",i),("\n",width)]
concatMap (\(b,c) -> if b == "" then return (fst a++c++if length c < snd a then " " else "", snd alength c 1, 0) else do
(dw,di,du) <- tsetw width c
return (fst a++b++"-\n"++dw, di, du+1)
) $ filter (\(b,c) -> if b /= "" then length b < snd a else length c <= snd a) $ combis [] $ hyphen w
paragraphs =
paragraph >>= \x -> case x of
Nothing -> return ()
Just s -> mprint s >> paragraphs
paragraph = mscannable >>= \b -> if not b then return Nothing else do
ts <- typeset width
case map (\(w,i,u) -> (w, u*u + sum (map (\s -> (width length s) * (width length s)) $ lines w))) ts of
[] -> return Nothing
cs -> return $ Just $ fst $ minimumBy (\a b -> snd a `compare` snd b) cs
typeset i = mscannable >>= \b -> if not b then return [("",i,0)] else do
ls <- skipw
if ls > 0 then return [(replicate ls '\n', width, 0)] else do
w <- scanw
let ts = tsetw i w
tx <- return ()
return []