{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} -- | EditBox.hs -- Multiline edit box widget. module Widgets.EditBox where import Graphics.Vty import Graphics.Vty.Widgets.Base import Graphics.Vty.Widgets.WrappedText -- | TODO: multiline data EditBox = EditBox { front, back :: String } ---------------------------------------------------------------------- -- | Create empty edit box. empty :: EditBox empty = EditBox "" "" -- | Get contents. contents :: EditBox -> String contents (EditBox{..}) = reverse front ++ back -- | Insert new symbol. insert :: Char -> EditBox -> EditBox insert c box = box {front = c : front box} resize w h = id ---------------------------------------------------------------------- -- editing commands -- TODO: more text editing commands (delete-world, delete-line and so on). moveLeft box@(EditBox{front = c:front', back}) = box {front = front', back = c:back} moveLeft box = box moveRight box@(EditBox{front, back = c:back'}) = box {front = c:front, back = back'} moveRight box = box moveToHome box = box {front = "", back = contents box} moveToEnd box = box {front = reverse $ contents box, back = ""} backSpace box@(EditBox{front = c:front'}) = box {front = front'} backSpace box = box delete box@(EditBox{back = c:back'}) = box {back = back'} delete box = box ---------------------------------------------------------------------- -- render instance Widget EditBox where growHorizontal _ = True growVertical _ = False primaryAttribute _ = def_attr withAttribute w _ = w -- TODO: convert empty lines to hFill's render rgn box@(EditBox{front, back}) = render rgn $ case back of c : back' -> text def_attr (reverse front) <++> cursor c <++> text def_attr back' <++> hFill def_attr ' ' 1 [] -> text def_attr (reverse front) <++> cursor ' ' <++> hFill def_attr ' ' 1 where cursorAttr = def_attr `with_style` reverse_video cursor c = text cursorAttr [c]