hspresent-0.1: Main.hs

import System.Environment
import System.Exit
import System.IO

import Data.ByteString.Char8 (pack)
import Graphics.Vty

-- |Split an input list
split :: Eq a => [a] -> [[a]] -> [[[a]]]
split _ [] = [[]]
split tok (x:xs)
      | tok == x  = [] : split tok xs
      | otherwise = let (x':xs') = split tok xs in (x:x') : xs'

-- |Render a string as an Image, and right pad it with some character.
bsLine :: String -> Char -> Int -> Image
bsLine txt fill width = renderBS attr $ pack txt'
    where
      txt' = ' ' : txt ++ (replicate (width - length txt - 2) fill)

-- |Take a Vty and a list of frames, and do the presentation; this function
-- terminates when q or Ctrl-C are entered.
loop :: Vty -> [[String]] -> IO ()
loop vty frames = loop' 0
    where
      maxframe = length frames - 1
      formatText w [] = empty
      formatText w (x:xs) = (bsLine x ' ' w) <-> (formatText w xs)
      loop' n = do
        let (title:text) = frames !! n
        (w, h) <- getSize vty
        let im = bsLine title ' ' w <->
                 bsLine "" '-' w <->
                 formatText w text
        update vty (pic { pCursor = NoCursor,
                          pImage = im })
        ev <- getEvent vty
        case ev of
          EvKey KLeft _  -> loop' (max 0 (n-1))
          EvKey KRight _ -> loop' (min maxframe (n+1))
          EvKey (KASCII 'q') _       -> return ()
          EvKey (KASCII 'c') [MCtrl] -> return ()
          _              -> loop' n

main = do
  args <- getArgs
  presentation <- parse args
  h <- openFile presentation ReadMode
  frames <- fmap makeFrames $ hGetContents h
  vty <- mkVty
  refresh vty
  loop vty frames
  shutdown vty
  where
    makeFrames s = split "--" $ lines s

    parse ["-h"] = usage
    parse [x]    = return x
    parse _      = usage

    usage = putStrLn "Usage: hspresent [-h] <presentation>" >> exit
    exit = exitWith ExitSuccess