module DarkPlaces.Text (
DPText(..),
DPTextToken(..),
DecodeType(..),
DPStreamState(..),
BinStreamState,
PrintStreamArgs(..),
BinaryDPText,
DecodedDPText,
parseDPText,
defaultStreamState,
defaultPrintStreamArgs,
stripColors,
minimizeColors,
simplifyColors,
hPrintDPText,
printDPText,
hPrintStreamDPText,
printStreamDPText,
hStreamEnd,
streamEnd,
toUTF,
toASCII,
hSupportColors,
supportColors,
hPutDPText,
hPutDPTextLn,
putDPText,
putDPTextLn
) where
import DarkPlaces.Text.Lexer
import DarkPlaces.Text.Types
import DarkPlaces.Text.Colors
import DarkPlaces.Text.Chars
import DarkPlaces.Text.Classes
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TEE
import System.IO (Handle, stdout, hPutStrLn)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.UTF8 as BLU
import System.Console.ANSI (hSupportsANSI)
import Data.String
import Data.Monoid
data PrintStreamArgs = PrintStreamArgs {
withColor :: Bool,
streamState :: BinStreamState,
decodeFun :: DecodeFun BL.ByteString T.Text
}
defaultPrintStreamArgs :: PrintStreamArgs
defaultPrintStreamArgs = PrintStreamArgs True defaultStreamState (toUTF Utf8Lenient)
stripColors :: DPText a -> DPText a
stripColors (DPText t) = DPText $ filter isTextData t
minimizeColors' :: (Eq a) => DPTextToken a -> DPText a -> DPText a
minimizeColors' sc (DPText t) = DPText $ minimize' t sc
where
minimize' (x:xs) c
| isColor x && x == c = minimize' xs c
| isColor x = x : minimize' xs x
| isNewline x = x : minimize' xs start_color
| otherwise = x : minimize' xs c
minimize' [] _ = []
start_color = SimpleColor 0
minimizeColors :: (Eq a) => DPText a -> DPText a
minimizeColors = minimizeColors' (SimpleColor 0)
simplifyColors :: DPText a -> DPText a
simplifyColors (DPText t) = DPText $ map convert t
where
convert (HexColor h) = SimpleColor (simplifyColor h)
convert x = x
splitStreamDPText :: DPStreamState a -> DPText a -> (DPText a, DPStreamState a)
splitStreamDPText st (DPText t) = (\(a, b) -> (DPText a, b)) $ go t st
where
go [] st = ([], st)
go [DPString s] st = ([], st {streamLeft=s})
go (x:xs) st = let st' = if isColor x then st {streamColor=x} else st
(xs', st'') = go xs st'
in (x : xs', st'')
parseStreamDPText :: BinStreamState -> BL.ByteString -> (BinaryDPText, BinStreamState)
parseStreamDPText st bin_data = splitStreamDPText st' dp_text
where
dp_text = parseDPText $ streamLeft st <> bin_data
st' = st {streamLeft=BL.empty}
printColors :: (Printable a, Eq a) => Handle -> DPText a -> IO ()
printColors h = hPutPrintable h . minimizeColors . simplifyColors
printStreamColors :: (Printable a, Eq a) => Handle -> DPStreamState a -> DPText a -> IO ()
printStreamColors h st = hPutPrintable h . minimizeColors' (streamColor st) . simplifyColors
hPutDPText :: (Printable a, Eq a) => Handle -> DPText a -> IO ()
hPutDPText h t = printColors h t >> hReset h
hPutDPTextNoColors :: (Printable a, Eq a) => Handle -> DPText a -> IO ()
hPutDPTextNoColors h t = putDPTextNoReset h $ stripColors t
hPutDPTextLn :: (Printable a, Eq a) => Handle -> DPText a -> IO ()
hPutDPTextLn h t = hPutDPText h t >> hPutStrLn h ""
putDPText :: (Printable a, Eq a) => DPText a -> IO ()
putDPText = hPutDPText stdout
putDPTextLn :: (Printable a, Eq a) => DPText a -> IO ()
putDPTextLn = hPutDPTextLn stdout
hPrintDPText ::(Printable a, Eq a) => Handle -> DecodeFun BL.ByteString a -> Bool -> BL.ByteString -> IO ()
hPrintDPText handle fun color text = if color
then hPutDPText handle dptext
else hPutDPTextNoColors handle dptext
where
dptext = fun $ parseDPText text
printDPText :: (Printable a, Eq a) => DecodeFun BL.ByteString a -> Bool -> BL.ByteString -> IO ()
printDPText = hPrintDPText stdout
hPrintStreamDPText :: Handle -> PrintStreamArgs -> BL.ByteString -> IO BinStreamState
hPrintStreamDPText h (PrintStreamArgs color st fun) bin = (if color
then printStreamColors h st_dec dptext
else hPutDPTextNoColors h dptext) >> return st'
where
(bintext, st') = parseStreamDPText st bin
dptext = fun bintext
st_dec = mapDPTextStream (const T.empty) st
printStreamDPText :: PrintStreamArgs -> BL.ByteString -> IO BinStreamState
printStreamDPText = hPrintStreamDPText stdout
hStreamEnd :: Handle -> Bool -> BinStreamState -> IO ()
hStreamEnd h color st = if color && streamColor st /= (SimpleColor 0)
then hReset h
else return ()
streamEnd :: Bool -> BinStreamState -> IO ()
streamEnd = hStreamEnd stdout
instance IsString (DPText BL.ByteString) where
fromString = parseDPText . BLU.fromString
toDecodedDPText :: DecodeType -> BinaryDPText -> DecodedDPText
toDecodedDPText dec_type = mapDPText (decodeFun dec_type . BL.toStrict)
where
decodeFun Utf8Lenient = TE.decodeUtf8With TEE.lenientDecode
decodeFun Utf8Ignore = TE.decodeUtf8With TEE.ignore
decodeFun Utf8Strict = TE.decodeUtf8With TEE.strictDecode
decodeFun NexuizDecode = TE.decodeLatin1
toUTF :: DecodeType -> BinaryDPText -> DecodedDPText
toUTF dec_type bin_text = decodeDPTextUTF (dec_type /= NexuizDecode) dec_text
where
dec_text = toDecodedDPText dec_type bin_text
toASCII :: DecodeType -> BinaryDPText -> DecodedDPText
toASCII dec_type bin_text = decodeDPTextASCII (dec_type /= NexuizDecode) dec_text
where
dec_text = toDecodedDPText dec_type bin_text
hSupportColors :: Handle -> IO Bool
hSupportColors = hSupportsANSI
supportColors :: IO Bool
supportColors = hSupportColors stdout