module Graphics.Vty.Menu(displayMenu,displayMenuOfValues) where
import qualified Graphics.Vty as Vty
import Graphics.Vty.Input
import Graphics.Vty.Output
import Graphics.Vty.Config
getName :: String -> String
getName item = item
itemImage :: String -> Bool -> Vty.Image
itemImage item cursor = do
let
wfc = Vty.withForeColor
wbc = Vty.withBackColor
(indicator, useColor) =
if cursor
then (" > ", True)
else (" ", False)
attr =
if useColor
then Vty.currentAttr `wfc` Vty.black `wbc` Vty.white
else Vty.currentAttr `wfc` Vty.white `wbc` Vty.black
Vty.string attr $ indicator ++ (getName item)
allocate :: IO Vty.Vty
allocate = do
vt <- standardIOConfig >>= Vty.mkVty
return vt
deallocate :: Vty.Vty -> IO ()
deallocate vt =
Vty.shutdown vt
handleKeyboard :: Vty.Key -> Int -> Int -> [String] -> Vty.Vty -> IO (Vty.Vty,Maybe Int)
handleKeyboard key position offset items vt = case key of
KChar 'q' -> return (vt,Nothing)
KEsc -> return (vt,Nothing)
KEnter -> return (vt,Just position)
KChar 'j' -> work (position + 1) offset items vt
KDown -> work (position + 1) offset items vt
KChar 'k' -> work (position 1) offset items vt
KUp -> work (position 1) offset items vt
_ -> work position offset items vt
work :: Int -> Int -> [String] -> Vty.Vty -> IO (Vty.Vty,Maybe Int)
work requestedPosition offset items vt = do
let position = max 0 (min requestedPosition (length items 1))
(cols, rows) <- displayBounds $ Vty.outputIface vt
let
(cols2, rows2) = (fromEnum cols, fromEnum rows)
screenPosition = position + offset
offset2 =
if screenPosition >= rows2
then offset (screenPosition rows2 + 1)
else if screenPosition < 0
then offset screenPosition
else offset
items2 = drop (0 offset2) $ zip [0..] items
itemImages =
map
(\(line, item) -> itemImage item (line == position))
items2
imagesUnified = Vty.vertCat itemImages
pic = Vty.picForImage $ imagesUnified
Vty.update vt pic
eventLoop position offset2 items vt
eventLoop :: Int -> Int -> [String] -> Vty.Vty -> IO (Vty.Vty, Maybe Int)
eventLoop position offset items vt = do
ev <- Vty.nextEvent vt
case ev of
Vty.EvKey key _ -> handleKeyboard key position offset items vt
_ -> eventLoop position offset items vt
displayMenu :: [String] -> IO (Maybe String)
displayMenu items = do
displayMenuOfValues $ zip items items
displayMenuOfValues :: [(String,a)] -> IO (Maybe a)
displayMenuOfValues items = do
vty <- allocate
(vty',maybePos) <- work 0 0 (map fst items) vty
deallocate vty'
case maybePos of
Just pos -> return $ Just $ snd $ items !! pos
Nothing -> return Nothing