matsuri-0.0.2: Widgets/EditBox.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}


-- | One-line edit box widget.
module Widgets.EditBox
  ( EditBox
  , editBox
  , defaultEditBox
  , fixedWidthEditBox
  , fixedWidthDefaultEditBox
  , empty
  , contents
  , current

  , defaultKeyHandler
  , insert
  , moveLeft
  , moveRight
  , moveWordLeft
  , moveWordRight
  , moveToHome
  , moveToEnd
  , backSpace
  , delete
  , resize
  )
  where


import Data.Char

import Graphics.Vty
import Graphics.Vty.Widgets.Base
import Graphics.Vty.Widgets.WrappedText


-- | Edit box can have fixed width or it expands to fill all available space.
-- | TODO: если размеры будут задаваться внешними по отношению к vty-ui методами, то разделение на fixed/free не нужно
data Size = Free {getSize :: Int} | Fixed {getSize :: Int}

data EditBox
  = EditBox
    { primAttr :: Attr
    , currentAttrFn :: Attr -> Attr
    , width :: Size
    , windowStart :: Int
    , front :: String -- ^ text before cursor (in reversed order)
    , back  :: String -- ^ current char and text after it
    }


----------------------------------------------------------------------
-- | Creates empty edit box that fills all available width.
editBox attr fn = EditBox attr fn (Free 0) 0 "" ""
defaultEditBox = editBox def_attr (`with_style` reverse_video)

-- | Creates empty edit box with fixed width.
fixedWidthEditBox attr fn w = EditBox attr fn (Fixed w) 0 "" ""
fixedWidthDefaultEditBox = fixedWidthEditBox def_attr (`with_style` reverse_video)


-- | Empties edit box.
empty t = t {windowStart = 0, front = "", back = ""}

-- | Returns text contained in edit box.
contents (EditBox{..}) = reverse front ++ back

-- | Returns current character.
current (EditBox{back})
  = if null back then Nothing else Just $ head back

-- | Returns current size of edit box.
size = getSize . width

-- | Handles key events from vty
defaultKeyHandler box ev
  = ($box) $ case ev of
    EvKey (KASCII  c) []      -> Just . insert c
    EvKey KLeft       []      -> Just . moveLeft
    EvKey KRight      []      -> Just . moveRight
    EvKey KLeft       [MCtrl] -> Just . moveWordLeft
    EvKey KRight      [MCtrl] -> Just . moveWordRight
    EvKey KHome       []      -> Just . moveToHome
    EvKey KEnd        []      -> Just . moveToEnd
    EvKey KBS         []      -> Just . backSpace
    EvKey KDel        []      -> Just . delete
    _ -> const Nothing


----------------------------------------------------------------------
-- editing commands
-- TODO: more text editing commands (delete-world, delete-line and so on).
-- FIXME: tab breaks input

-- | Inserts one symbol before cursor.
insert c box = scrollWindow $ box {front = c':front box}
  where -- FIXME: что делать с tab'ом в insert? | а ничего с ним не
        -- надо, по табу ники перебирать же.
    c' = if elem c "\r\n\t" then ' ' else c -- filter 'bad' symbols

-- | Moves cursor one position left. Scrolls text if necessary.
moveLeft box@(EditBox{front = c:front',back})
  = scrollWindow $ box {front = front', back = c:back}
moveLeft box = box

-- | Moves cursor one position right. Scrolls text if necessary.
moveRight box@(EditBox{front, back = c:back'})
  = scrollWindow $ box {front = c:front, back = back'}
moveRight box = box


-- | Skip all spaces then skip word.
skipWord move
  = head
  . dropWhile (inBounds .&&. (inWord.current))
  . dropWhile (inBounds .&&. (not.inWord.current))
  . iterate move
  . move
  where
    inWord Nothing = False
    inWord (Just c) = isAlphaNum c
    inBounds = (not.null.front) .&&. (not.null.back)

(.&&.) f g x = f x && g x

-- | Moves cursor one word left. Scrolls if necessary.
moveWordLeft = skipWord moveLeft

-- | Moves cursor one word right. Scrolls if nesessary.
moveWordRight = skipWord moveRight

-- | Moves cursor to the very beginning of the text.
moveToHome box = scrollWindow $ box {front = "", back = contents box}

-- | Moves cursor to the end of the text.
moveToEnd  box = scrollWindow $ box {front = reverse $ contents box, back = ""}

-- | Removes symbol before cursor.
backSpace box@(EditBox{front = c:front'}) = scrollWindow $ box {front = front'}
backSpace box = box

-- | Removes current symbol.
delete box@(EditBox{back = c:back'}) = scrollWindow $ box {back = back'}
delete box = box

-- | Updates internal variable that represents edit box width.
-- Used only as a response to EvResize.
-- If you wish to resize fixed size edit box, you need to creatie a new one.
resize w box@(EditBox{width})
  = case width of
    Free _ -> scrollWindow $ box {width = Free w}
    _      -> box


-- | Scrolls text if cursor is not visible.
scrollWindow box@(EditBox{front, width, windowStart = ws})
  | fLen - ws > w-1 = box {windowStart = fLen - w+1}
  | fLen < ws       = box {windowStart = fLen}
  | otherwise       = box
  where
    fLen = length front
    w = getSize width


----------------------------------------------------------------------
-- render

instance Widget EditBox where
  -- growHorizontal :: w -> Bool
  growHorizontal (EditBox{width = Free _}) = True
  growHorizontal _ = False

  -- growVertical :: w -> Bool
  growVertical _ = False

  -- primaryAttribute :: w -> Attr
  primaryAttribute = primAttr

  -- withAttribute :: w -> Attr -> w
  withAttribute w a = w {primAttr = a}

  -- render :: DisplayRegion -> w -> Image
  render rgn box@(EditBox{..})
    = render rgn
      $    text primAttr front'
      <++> text (currentAttrFn primAttr) [c]
      <++> text primAttr (back' ++ fill)
    where
      front' = drop windowStart $ reverse front
      (c:back')
        | null back = ' ':[]
        | otherwise = take (getSize width - length front') back
      fill = replicate (getSize width - length front' - length back' - 1) ' '