content: {-# Language BangPatterns #-}
  
  {-|
  Module      : Client.Image.Textbox
  Description : Textbox renderer
  Copyright   : (c) Eric Mertens, 2016
  License     : ISC
  Maintainer  : emertens@gmail.com
  
  This module provides the renderer for the client's text box input.
  
  -}
  
  module Client.Image.Textbox
    ( textboxImage
    ) where
  
  import Client.Configuration
  import Client.Commands (Command(Command, cmdArgumentSpec), commands)
  import Client.Commands.Arguments.Renderer (render)
  import Client.Commands.Arguments.Parser (parse)
  import Client.Commands.Interpolation (Macro(macroSpec), MacroSpec(..))
  import Client.Commands.Recognizer
  import Client.Commands.Types (makeArgsContext)
  import Client.Image.LineWrap (fullLineWrap, terminate)
  import Client.Image.Message (cleanChar, parseIrcTextWithNicks, Highlight)
  import Client.Image.MircFormatting (parseIrcText', plainText)
  import Client.Image.PackedImage (char, imageWidth, string, unpackImage, Image')
  import Client.Image.Palette
  import Client.State
  import Client.State.EditBox qualified as Edit
  import Control.Lens (view, views)
  import Data.HashMap.Strict (HashMap)
  import Data.List (intersperse)
  import Data.Text qualified as Text
  import Graphics.Vty.Attributes (defAttr)
  import Graphics.Vty.Image qualified as Vty
  import Irc.Identifier (Identifier)
  
  textboxImage :: Int -> Int -> ClientState -> (Int, Int, Int, Vty.Image) -- ^ cursor column, new offset, image
  textboxImage maxHeight width st =
    case view clientEditMode st of
      SingleLineEditor -> singleLineTextboxImage maxHeight width st
      MultiLineEditor  -> multiLineTextboxImage  maxHeight width st
  
  multiLineTextboxImage :: Int -> Int -> ClientState -> (Int, Int, Int, Vty.Image) -- ^ cursor column, new offset, image
  multiLineTextboxImage _maxHeight width st = (cursorRow, cursorCol, view clientTextBoxOffset st, output)
    where
    output = Vty.vertCat (terminate width . unpackImage <$> imgs)
  
    imgs = as ++ c ++ bs
  
    content = view (clientTextBox . Edit.content) st
  
    as  = concatMap (fullLineWrap width)
        $ mapHead (beginning <>)
        $ map (<> plainText "\n")
        $ rndr False <$> reverse (view Edit.above content)
  
    bs  = concatMap (fullLineWrap width)
        $ endAfters
        $ rndr False <$> view Edit.below content
  
    cur = view Edit.line content
    curTxt  = view Edit.text cur
  
    cursorBase
      = imageWidth $ parseIrcText' True pal
      $ Text.pack
      $ take (view Edit.pos cur) curTxt
  
    (cursorRow, cursorCol) =
      calcCol (length c + length bs) c (if null as then 1 + cursorBase else cursorBase)
  
    c = fullLineWrap width
      $ (if null as then beginning else mempty)
     <> rndr True curTxt
     <> (if null bs then ending else plainText "\n")
  
    rndr = renderLine st pal hilites macros
    pal = clientPalette st
    hilites = clientHighlightsFocus (view clientFocus st) st
    macros = views (clientConfig . configMacros) (fmap macroSpec) st
  
    attr      = view palTextBox pal
    beginning = char attr '^'
    ending    = char attr '$'
  
    endAfters [] = []
    endAfters [x] = [x <> ending]
    endAfters (x:xs) = x <> plainText "\n" : endAfters xs
  
    -- Using fullLineWrap make calculating the cursor much easier
    -- to switch to word-breaking lineWrap we'll need some extra
    -- logic to count skipped spaces.
    calcCol row [] _ = (row, 0)
    calcCol row (i:is) n
      | n < w = (row, n)
      | otherwise = calcCol (row-1) is (n-w)
      where
        w = imageWidth i
  
  mapHead :: (a -> a) -> [a] -> [a]
  mapHead f (x:xs) = f x : xs
  mapHead _ []     = []
  
  -- | Compute the UI image for the text input box. This computes
  -- the logical cursor position on the screen to compensate for
  -- VTY's cursor placement behavior.
  singleLineTextboxImage :: Int -> Int -> ClientState -> (Int, Int, Int, Vty.Image) -- ^ cursor column, new offset, image
  singleLineTextboxImage _maxHeight width st
    = (1, newPos, newOffset, croppedImage)
    where
    macros = views (clientConfig . configMacros) (fmap macroSpec) st
    (txt, content) =
       renderContent st hilites macros pal
         (view (clientTextBox . Edit.content) st)
  
    lineImage = unpackImage (beginning <> content <> ending)
  
    leftOfCurWidth = 1 + txt
  
    croppedImage = Vty.resizeWidth width
                 $ Vty.cropLeft (Vty.imageWidth lineImage - newOffset) lineImage
  
    cursorAnchor = width * 3 `quot` 4
  
    -- previous offset value
    oldOffset = view clientTextBoxOffset st
  
    -- position based on old offset
    oldPos = leftOfCurWidth - oldOffset
  
    -- new offset (number of columns to trim from left side of text box)
    newOffset
      | 0 <= oldPos, oldPos < width = oldOffset
      | otherwise                   = max 0 (leftOfCurWidth - cursorAnchor)
  
    newPos = leftOfCurWidth - newOffset
  
    pal       = clientPalette st
    attr      = view palTextBox pal
    beginning = char attr '^'
    ending    = char attr '$'
  
    hilites = clientHighlightsFocus (view clientFocus st) st
  
  
  -- | Renders the whole, uncropped text box as well as the 'String'
  -- corresponding to the rendered image which can be used for computing
  -- the logical cursor position of the cropped version of the text box.
  renderContent ::
    ClientState          {- ^ client state                          -} ->
    HashMap Identifier Highlight {- ^ highlights                    -} ->
    Recognizer MacroSpec {- ^ macro completions                     -} ->
    Palette              {- ^ palette                               -} ->
    Edit.Content         {- ^ content                               -} ->
    (Int, Image')        {- ^ left-of-cursor width, image rendering -}
  renderContent st hilites macros pal c = (leftLen, 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)
  
    -- ["one","two"] "three" --> "two one three"
    leftLen = length leftImgs -- separators
            + sum (map imageWidth leftImgs)
            + imageWidth (parseIrcText' True pal (Text.pack leftCur))
  
    rndr = renderLine st pal hilites macros
  
    leftImgs = map (rndr False) as
  
    wholeImg = mconcat
             $ intersperse (plainText "\n")
             $ leftImgs
            ++ rndr True curTxt
             : map (rndr False) bs
  
  
  -- | Render the active text box line using command highlighting and
  -- placeholders, and WYSIWYG mIRC formatting control characters.
  renderLine ::
    ClientState ->
    Palette ->
    HashMap Identifier Highlight ->
    Recognizer MacroSpec {- ^ commands     -} ->
    Bool                 {- ^ focused      -} ->
    String               {- ^ input text   -} ->
    Image'               {- ^ output image -}
  renderLine st pal hilites macros focused input =
  
    case span (' '==) input of
      (spcs, '/':xs) -> string defAttr spcs <> char defAttr '/'
                     <> string attr cleanCmd <> continue rest
        where
          specAttr spec =
            case parse (makeArgsContext st) spec rest of
              Nothing -> view palCommand      pal
              Just{}  -> view palCommandReady pal
  
          (cmd, rest) = break (' '==) xs
          cleanCmd = map cleanChar cmd
  
          allCommands = (Left <$> macros) <> (Right <$> commands)
          (attr, continue)
            = case recognize (Text.toLower (Text.pack cmd)) allCommands of
                Exact (Right Command{cmdArgumentSpec = spec}) ->
                  ( specAttr spec
                  , render pal (makeArgsContext st) focused spec
                  )
                Exact (Left (MacroSpec spec)) ->
                  ( specAttr spec
                  , render pal st focused spec
                  )
                Prefix _ ->
                  ( view palCommandPrefix pal
                  , parseIrcTextWithNicks pal hilites focused . Text.pack
                  )
                Invalid ->
                  ( view palCommandError pal
                  , parseIrcTextWithNicks pal hilites focused . Text.pack
                  )
      _ -> parseIrcTextWithNicks pal hilites focused (Text.pack input)
  