module Todos.Default.Curses (cursesPrintTodos) where
import Control.Monad
import Control.Monad.Reader
import System.IO
import System.Console.ANSI as ANSI
import UI.HSCurses.Curses as Curses
import System.Locale.SetLocale
import Todos.Types
import Todos.Tree
import Todos.Default.Config
import Todos.Default.Print (showTodos, defaultPrintTodos)
import Todos.Formatters hiding (outItem)
toCursesColor ∷ ANSI.Color → Curses.Color
toCursesColor ANSI.Black = Curses.Color 0
toCursesColor ANSI.Red = Curses.Color 1
toCursesColor ANSI.Green = Curses.Color 2
toCursesColor ANSI.Yellow = Curses.Color 3
toCursesColor ANSI.Blue = Curses.Color 4
toCursesColor ANSI.Magenta = Curses.Color 5
toCursesColor ANSI.Cyan = Curses.Color 6
toCursesColor ANSI.White = Curses.Color 7
setColor ∷ Window → ANSI.ColorIntensity → ANSI.Color → IO ()
setColor pad int clr = do
let (Curses.Color c) = toCursesColor clr
(attr, _) ← wAttrGet pad
let attr' = case int of
ANSI.Vivid → Curses.setBold attr True
ANSI.Dull → attr
wAttrSet pad (attr', Pair c)
setBoldW ∷ Window → IO ()
setBoldW pad = do
(attr, pair) ← wAttrGet pad
wAttrSet pad (Curses.setBold attr True, pair)
reset ∷ Window → IO ()
reset pad = wAttrSet pad (attr0, Pair 0)
outItem ∷ Window → OutItem → IO ()
outItem pad (OutString s) = wAddStr pad s
outItem pad (OutSetColor i c) = setColor pad i c
outItem pad SetBold = setBoldW pad
outItem pad ResetAll = reset pad
cursesPrintTodos ∷ (TodoItem → IO ()) → PrintConfig DefaultConfig → [Todo] → IO ()
cursesPrintTodos run cfg lst = do
tty ← hIsTerminalDevice stdout
if not tty
then defaultPrintTodos cfg lst
else do
todos <- if hasCycles lst
then do
hPutStrLn stderr "Warning: cycles in TODOs; `execute' will not work"
return lst
else return $ markLevels $ enumerateTodos lst
setLocale LC_ALL Nothing
initCurses
(lines,cols) ← scrSize
let nLines = fromIntegral $ treeLines todos
if nLines >= lines
then do
np ← colorPairs
nc ← colors
let m = min np nc
forM_ [0..m1] $ \i →
initPair (Pair i) (Curses.Color i) (Curses.Color (1))
pad ← newPad nLines cols
let lst' = runReader (showTodos todos) cfg
forM lst' (outItem pad)
echo False
scrollPad pad nLines lines cols (runByNumber run todos)
delWin pad
endWin
else do
endWin
defaultPrintTodos cfg lst
runByNumber ∷ (TodoItem → IO ()) → [Todo] → Int → IO ()
runByNumber run todos i =
case itemByNumber todos (fromIntegral i) of
Nothing → putStrLn $ "Not found: " ++ show i
Just x → run x
scrollPad ∷ Window → Int → Int → Int → (Int → IO ()) → IO ()
scrollPad pad padLines lines cols run = do
wMove pad 0 0
scrollToLine 0
waitForKeys 0
where
scrollToLine i = pRefresh pad i 0 0 0 (lines1) (cols1)
scroll i = do
scrollToLine i
waitForKeys i
moveDown i = do
(y,x) ← getYX pad
wMove pad (min (padLines1) (y+1)) x
if yi == lines 1
then scroll $ min (padLines lines) (i+1)
else scroll i
moveUp i = do
(y,x) ← getYX pad
wMove pad (max 0 (y1)) x
if y == i
then scroll $ max 0 (i1)
else scroll i
moveRight i = do
(y,x) ← getYX pad
wMove pad y $ min (cols1) (x+1)
scroll i
moveLeft i = do
(y,x) ← getYX pad
wMove pad y $ max 0 (x1)
scroll i
runSelected = do
(y,_) ← getYX pad
wAddStr pad (show y)
run (y+1)
waitForKeys i = do
c ← getCh
case c of
KeyChar 'q' → return ()
KeyChar 'j' → moveDown i
KeyChar 'k' → moveUp i
KeyChar 'h' → moveLeft i
KeyChar 'l' → moveRight i
KeyChar 'g' → scroll 0
KeyChar 'G' → scroll (padLines lines)
KeyChar 'e' → runSelected
_ → beep >> waitForKeys i