matsuri-0.0.2: Widgets/ListBox.hs

{-# LANGUAGE RecordWildCards #-}

-- | ListBox.hs
-- ListBox widget.
module Widgets.ListBox where

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


data ListBox
  = ListBox
    { selectedAttr  :: Attr
    , defaultAttr   :: Attr
    , selectedIndex :: Int
    , listWidth     :: Int
    , items         :: [(String, Value)]
    }
type Value = String

empty
  = ListBox
    { selectedAttr  = def_attr `with_back_color` cyan
                               `with_fore_color` blue
    , defaultAttr   = def_attr
    , selectedIndex = 0
    , listWidth     = 30
    , items         = []
    }


----------------------------------------------------------------------
-- moves
-- TODO: first, end, pageup, pagedn

moveUp l@(ListBox {selectedIndex = sIx})
  | sIx == 0  = l
  | otherwise = l { selectedIndex = sIx-1 }

moveDn l@(ListBox {selectedIndex = sIx})
  | sIx == listSize - 1 = l
  | otherwise           = l { selectedIndex = sIx+1 }
  where
    listSize = length $ items l


----------------------------------------------------------------------
-- rendering

instance Widget ListBox where
    growHorizontal _ = False
    growVertical   _ = True
    primaryAttribute _ = def_attr
    withAttribute w _ = w

    render rgn l@(ListBox {..})
      = vert_cat
        $  map (renderLine defaultAttr) a
        ++ [renderLine selectedAttr n]
        ++ map (renderLine defaultAttr) b
      where
        width  = listWidth
        height = fromIntegral $ region_height rgn
        (a, n:b) = splitAt selectedIndex items
        renderLine attr = string attr . take' width ' ' . fst

---
cur l = snd $ (items l)!!(selectedIndex l)
take' n add lst = if length lst < n
                  then lst ++ replicate (n - length lst) add
                  else take n lst