{-# Language BangPatterns #-}
module Client.Image.Textbox
( textboxImage
) where
import Client.Configuration
import Client.Commands
import Client.Commands.Arguments
import Client.Image.Arguments
import Client.Image.MircFormatting
import Client.Image.Palette
import Client.State
import qualified Client.State.EditBox as Edit
import Control.Lens
import Data.Char
import Data.List
import qualified Data.Text as Text
import Graphics.Vty.Image
textboxImage :: ClientState -> (Int, Image)
textboxImage st
= (pos, croppedImage)
where
width = view clientWidth st
(txt, content) =
views (clientTextBox . Edit.content) (renderContent pal) st
pos = min (width-1) leftOfCurWidth
pal = view (clientConfig . configPalette) st
lineImage = beginning <|> content <|> ending
leftOfCurWidth = myWcswidth ('^':txt)
croppedImage
| leftOfCurWidth < width = lineImage
| otherwise = cropLeft width (cropRight (leftOfCurWidth+1) lineImage)
attr = view (clientConfig . configPalette . palTextBox) st
beginning = char attr '^'
ending = char attr '$'
renderContent ::
Palette ->
Edit.Content ->
(String, Image)
renderContent pal c = (txt, wholeImg)
where
as = reverse (view Edit.above c)
bs = view Edit.below c
cur = view Edit.line c
curTxt = view Edit.text cur
leftCur = take (view Edit.pos cur) (view Edit.text cur)
txt = foldl (\acc x -> x ++ ' ' : acc) leftCur as
wholeImg = horizCat
$ intersperse (plainText "\n")
$ map renderOtherLine as
++ renderLine pal curTxt
: map renderOtherLine bs
myWcwidth :: Char -> Int
myWcwidth x
| isControl x = 1
| otherwise = wcwidth x
myWcswidth :: String -> Int
myWcswidth = sum . map myWcwidth
renderOtherLine :: String -> Image
renderOtherLine = parseIrcTextExplicit . Text.pack
renderLine :: Palette -> String -> Image
renderLine pal ('/':xs)
| (cmd,rest) <- break isSpace xs
, Just (Command spec _ _) <- view (at (Text.pack cmd)) commands
, let attr =
case parseArguments spec rest of
Nothing -> view palCommand pal
Just{} -> view palCommandReady pal
= char defAttr '/' <|>
string attr cmd <|>
argumentsImage pal spec rest
renderLine _ xs = parseIrcTextExplicit (Text.pack xs)