matsuri-0.0.1: Widgets/EditBox.hs

{-# 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]