therning.org/ magnus

I haven’t had much free time lately, which means I haven’t written much non-work code. The only exception is some experiments with a small piece of Haskell code using the Vty module. Many moons ago I wrote a small piece of code that let’s the user choose options from a list in a terminal. Somewhat similar to what you get using dialog --menu ..., but of course a lot more limited and less good looking.

Anyway, over the last few weeks I’ve slowly expanded it in a direction that would be useful if I ever get around to work on yet another of those projects that so far only exist in my head

I’ve kept the transformations in a stack of patches using quilt, and I thought I’d write a little about them. Not because I think they are extremely useful or even good in any way, but more because I really need to get back to writing some blog posts

This is the zeroth post containing the version I put together when I first came across Vty. It is an executable program so it starts with the familiar

module Main where

Next comes a few modules that have to be imported:

import Data.Maybe
import Graphics.Vty
import qualified Data.ByteString.Char8 as B

The options are, in this version, represented as a list of strings. For now it’s enough to have a nonsensical list of unique strings.

options = [ (show i) ++ " Foo" | i <- [0..59]]

The main function is as small as possible, two rows, the first creating an instance of Vty and the second getting the choice and feeding it into print.

main = do
    vt <- mkVty
    getChoice vt options >>= print

Of course one would think that geChoice would be the meat of the code, but it is also short. After getting the size of the terminal it calls _getChoice, which is the meat of the code. The reason for this split is the handling of resize events.

getChoice vt opts = do
    (sx, sy) <- getSize vt
    _getChoice vt opts 0 sx sy

The main part of _getChoice is straight forward, first update the terminal, then wait for an event, and finally handle the event. Unless the user wants to exit (pressing enter choses an item, pressing escape exits without a choice) a recursive call is made to _getChoice with slightly modified arguments.

Probably the most complicated part is the calculation of the top of the list of visible items. The idea is that if the list has more items than there are lines in the terminal then the cursor moves down until the middle line, once there any down movement will result in the list scrolling up. This continues until the end of the list is visible, at that point the cursor moves down towards the last line in the terminal. I doubt that explanation makes sense, hopefully it’ll be clear to anyone who bothers running the code.

_getChoice vt opts idx sx sy =
    let
        _calcTop winHeight listLength idx = max 0 ((min listLength ((max 0 (idx - winHeight `div` 2)) + winHeight)) - winHeight)
        _top = _calcTop sy (length opts) idx
        _visible_opts = take sy (drop _top opts)
    in do
        update vt (render _visible_opts (idx - _top) sx)
        k <- getEvent vt
        case k of
            EvKey KDown [] -> _getChoice vt opts (min (length opts - 1) (idx + 1)) sx sy
            EvKey KUp [] -> _getChoice vt opts (max 0 (idx - 1)) sx sy
            EvKey KEsc [] -> shutdown vt >> return Nothing
            EvKey KEnter [] -> shutdown vt >> return (Just $ (idx, opts !! idx))
            EvResize nx ny -> _getChoice vt opts idx nx ny
            _ -> _getChoice vt opts idx sx sy

The final piece is the code that renders the list. The items of the list are zipped together with a list of integers. Each such tuple is then rendered into a line((The reason for the line rendering looking so complicated is that Vty requires each line to be of equal lenght.)), where the line of the cursor is highlighted. The resulting list of rendered lines is then folded into a full image.

render opts idx sx = pic {
    pImage = foldr1 (<->) $ map _render1 $ zip [0..] opts
    }
    where
        _render1 (i, o) = renderHFill attr ' ' 5 <|> renderBS (_attr i) (B.pack o) <|> renderHFill attr ' ' (sx - 5 - length o)
        _attr i = if i /= idx
            then attr
            else setRV attr

That’s it, that’s the starting point. It’s also likely to be the longest post in this planned series.