module System.Console.Terminfo.Cursor(
termLines, termColumns,
autoRightMargin,
autoLeftMargin,
wraparoundGlitch,
carriageReturn,
newline,
scrollForward,
scrollReverse,
moveDown, moveLeft, moveRight, moveUp,
cursorDown1,
cursorLeft1,
cursorRight1,
cursorUp1,
cursorDown,
cursorLeft,
cursorRight,
cursorUp,
cursorAddress,
Point(..),
rowAddress,
columnAddress
) where
import System.Console.Terminfo.Base
import Control.Monad
termLines :: Capability Int
termColumns :: Capability Int
termLines = tiGetNum "lines"
termColumns = tiGetNum "columns"
autoRightMargin :: Capability Bool
autoRightMargin = tiGetFlag "am"
autoLeftMargin :: Capability Bool
autoLeftMargin = tiGetFlag "bw"
wraparoundGlitch :: Capability Bool
wraparoundGlitch = tiGetFlag "xenl"
cursorDown1Fixed :: Capability TermOutput
cursorDown1Fixed = do
str <- tiGetStr "cud1"
guard (str /= "\n")
tiGetOutput1 "cud1"
cursorDown1 :: Capability TermOutput
cursorDown1 = tiGetOutput1 "cud1"
cursorLeft1 :: Capability TermOutput
cursorLeft1 = tiGetOutput1 "cub1"
cursorRight1 :: Capability TermOutput
cursorRight1 = tiGetOutput1 "cuf1"
cursorUp1 :: Capability TermOutput
cursorUp1 = tiGetOutput1 "cuu1"
cursorDown :: Capability (Int -> TermOutput)
cursorDown = tiGetOutput1 "cud"
cursorLeft :: Capability (Int -> TermOutput)
cursorLeft = tiGetOutput1 "cub"
cursorRight :: Capability (Int -> TermOutput)
cursorRight = tiGetOutput1 "cuf"
cursorUp :: Capability (Int -> TermOutput)
cursorUp = tiGetOutput1 "cuu"
cursorHome :: Capability TermOutput
cursorHome = tiGetOutput1 "home"
cursorToLL :: Capability TermOutput
cursorToLL = tiGetOutput1 "ll"
move single param = let
tryBoth = do
s <- single
p <- param
return $ \n -> case n of
0 -> mempty
1 -> s
n -> p n
manySingle = do
s <- single
return $ \n -> mconcat $ replicate n s
in tryBoth `mplus` param `mplus` manySingle
moveLeft :: Capability (Int -> TermOutput)
moveLeft = move cursorLeft1 cursorLeft
moveRight :: Capability (Int -> TermOutput)
moveRight = move cursorRight1 cursorRight
moveUp :: Capability (Int -> TermOutput)
moveUp = move cursorUp1 cursorUp
moveDown :: Capability (Int -> TermOutput)
moveDown = move cursorDown1Fixed cursorDown
carriageReturn :: Capability TermOutput
carriageReturn = tiGetOutput1 "cr"
newline :: Capability TermOutput
newline = tiGetOutput1 "nel"
`mplus` (liftM2 mappend carriageReturn
(scrollForward `mplus` tiGetOutput1 "cud1"))
scrollForward :: Capability TermOutput
scrollForward = tiGetOutput1 "ind"
scrollReverse :: Capability TermOutput
scrollReverse = tiGetOutput1 "ri"
data Point = Point {row, col :: Int}
cursorAddress :: Capability (Point -> TermOutput)
cursorAddress = fmap (\g p -> g (row p) (col p)) $ tiGetOutput1 "cup"
columnAddress :: Capability (Int -> TermOutput)
columnAddress = tiGetOutput1 "hpa"
rowAddress :: Capability (Int -> TermOutput)
rowAddress = tiGetOutput1 "vpa"