{-# LANGUAGE RecordWildCards #-} -- | UI.hs -- User interface. module UI ( UIState(..), mkUI, mkListBox, defaultUI, resizeUI ) where import Buffers import Config import qualified Widgets.ListBox as L import qualified Widgets.EditBox as E import Widgets.PrettyBorders import Widgets.TextBox import Graphics.Vty import Graphics.Vty.Widgets.All import qualified Data.Map as M import Data.Maybe import Data.List data UIState = UIState { roster :: L.ListBox , textBox :: TextBox , edit :: E.EditBox } mkUI :: UIState -> Config -> Buffers -> Box mkUI (UIState {..}) config buffers = (if null $ getCF "show_roster" config then tb <--> text def_attr "" else roster{L.listWidth=size} <++> pVBorder def_attr <++> tb) <--> text (back blue) "info" <--> edit where tb = case getBuf (L.cur roster) buffers of BufAccount acc -> mkTextBox (accContents acc) config BufGroup grp -> mkTextBox (grpContents grp) config BufChat chat -> mkTextBox (chatContents chat) config BufRoom room -> mkTextBox (roomContents room) config _ -> mkTextBox [] config size = read $ getCF "roster_width" config mkTextBox :: [Content] -> Config -> TextBox mkTextBox cnts config = TextBox $ map cnt2line cnts where -- TODO: read colors from config cnt2line (Msg msg) = (def_attr, msg) cnt2line (MyMsg msg) = (fore yellow, msg) cnt2line (HistoryMsg msg) = (fore cyan, msg) cnt2line (InfoMsg msg) = (fore cyan, msg) cnt2line (ErrorMsg msg) = (fore magenta, msg) mkListBox :: L.ListBox -> Buffers -> L.ListBox mkListBox roster buffers = roster { L.items = items , L.selectedIndex = newIndex } where -- new index newIndex = if L.selectedIndex roster < length items then L.selectedIndex roster else 0 -- all items items = concat $ map mkAcc accs -- accounts accs = [ buf | buf@(BufAccount _) <- M.elems buffers ] --- mkAcc buf@(BufAccount acc) = (show buf, accName acc): (if accCollapsed acc then [] else concat $ map (mkGroup (accName acc)) (groups acc)) mkGroup k buf@(BufGroup grp) = (show buf, grpName grp): (if grpCollapsed grp then [] else map mkChat $ grpBufs $ grpItems grp) mkChat buf@(BufChat chat) = (show buf, chatName chat) mkChat buf@(BufRoom room) = (show buf, roomName room) -- get acc groups groups acc = [ buf | buf@(BufGroup _) <- els ] where els = M.elems $ M.filterWithKey (filt (accName acc++"|")) buffers filt prefix k _ = prefix `isPrefixOf` k -- get group chats grpBufs = catMaybes . map (flip M.lookup buffers) defaultUI :: Buffers -> UIState defaultUI buffers = UIState { roster = mkListBox L.empty buffers , textBox = TextBox [] , edit = E.defaultEditBox } resizeUI w _ ui@(UIState{..}) = ui {edit = E.resize w edit} --- fore = (def_attr `with_fore_color`) back = (def_attr `with_back_color`)