module UI.NCurses
(
Curses
, Update
, Window
, runCurses
, defaultWindow
, newWindow
, closeWindow
, cloneWindow
, updateWindow
, render
, moveCursor
, setColor
, drawString
, drawText
, drawBorder
, drawBox
, drawLineH
, drawLineV
, setBackground
, Attribute (..)
, setAttribute
, setAttributes
, Color (..)
, ColorID
, supportsColor
, canDefineColor
, defineColor
, queryColor
, defaultColorID
, newColorID
, setColorID
, maxColorID
, Glyph (..)
, glyphCornerUL
, glyphCornerLL
, glyphCornerUR
, glyphCornerLR
, glyphTeeL
, glyphTeeR
, glyphTeeB
, glyphTeeT
, glyphLineH
, glyphLineV
, glyphPlus
, glyphScan1
, glyphScan9
, glyphDiamond
, glyphStipple
, glyphDegree
, glyphPlusMinus
, glyphBullet
, glyphArrowL
, glyphArrowR
, glyphArrowD
, glyphArrowU
, glyphBoard
, glyphLantern
, glyphBlock
, glyphS3
, glyphS7
, glyphNE
, glyphLTE
, glyphGTE
, glyphPi
, glyphSterling
, Event (..)
, getEvent
, Key (..)
, ButtonState (..)
, MouseState (..)
, CursorMode(CursorInvisible, CursorVisible, CursorVeryVisible)
, setCursorMode
, setRaw
, setCBreak
, setEcho
, baudrate
, beep
, flash
, hasMouse
, enclosed
, screenSize
, setTouched
, setRowsTouched
, setKeypad
, getCursor
) where
import Control.Exception (bracket_)
import Control.Monad (when, unless)
import qualified Control.Monad.Trans.Reader as R
import Data.Char (chr, ord)
import Data.List (foldl')
import Data.Maybe (catMaybes)
import qualified Data.Map as M
import qualified Data.Text as T
import Foreign hiding (shift)
import Foreign.C
import qualified UI.NCurses.Enums as E
import UI.NCurses.Types
newtype CCharT = CCharT (Ptr (CCharT))
type AttrT = (CULong)
type MMaskT = (CULong)
runCurses :: Curses a -> IO a
runCurses = bracket_ initCurses endwin . unCurses where
allEvents = fromInteger (E.fromEnum E.ALL_MOUSE_EVENTS)
initCurses = do
void initscr
void cbreak
void $ mousemask allEvents nullPtr
hasColor <- has_colors
when (hasColor == 1) $ do
void start_color
void use_default_colors
stdscr <- peek c_stdscr
void $ keypad (Window stdscr) 1
void $ meta (Window stdscr) 1
wtimeout (Window stdscr) ( 1)
defaultWindow :: Curses Window
defaultWindow = Curses (Window `fmap` peek c_stdscr)
foreign import ccall "static &stdscr"
c_stdscr :: Ptr (Ptr Window)
newWindow :: Integer
-> Integer
-> Integer
-> Integer
-> Curses Window
newWindow rows cols x y = Curses $ do
win <- newwin
(fromInteger rows)
(fromInteger cols)
(fromInteger x)
(fromInteger y)
if windowPtr win == nullPtr
then error "newWindow: newwin() returned NULL"
else do
void $ keypad win 1
void $ meta win 1
wtimeout win ( 1)
return win
closeWindow :: Window -> Curses ()
closeWindow win = Curses (delwin win >>= checkRC "closeWindow")
cloneWindow :: Window -> Curses Window
cloneWindow old = Curses $ do
win <- dupwin old
if windowPtr win == nullPtr
then error "cloneWindow: dupwin() returned NULL"
else return win
updateWindow :: Window -> Update a -> Curses a
updateWindow win (Update reader) = do
a <- R.runReaderT reader win
Curses (wnoutrefresh win >>= checkRC "updateWindow")
return a
render :: Curses ()
render = Curses (doupdate >>= checkRC "render")
setColor :: ColorID -> Update ()
setColor (ColorID pair) = withWindow_ "setColor" $ \win ->
wcolor_set win pair nullPtr
moveCursor :: Integer
-> Integer
-> Update ()
moveCursor y x = withWindow_ "moveCursor" $ \win ->
wmove win (fromInteger y) (fromInteger x)
drawString :: String -> Update ()
drawString str = withWindow_ "drawString" $ \win ->
withCWString str (waddwstr win)
drawText :: T.Text -> Update ()
drawText txt = withWindow_ "drawText" $ \win ->
withCWString (T.unpack txt) (waddwstr win)
drawBorder :: Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Update ()
drawBorder le re te be tl tr bl br =
withWindow_ "drawBorder" $ \win ->
withGlyph le $ \pLE ->
withGlyph re $ \pRE ->
withGlyph te $ \pTE ->
withGlyph be $ \pBE ->
withGlyph tl $ \pTL ->
withGlyph tr $ \pTR ->
withGlyph bl $ \pBL ->
withGlyph br $ \pBR ->
wborder_set win pLE pRE pTE pBE pTL pTR pBL pBR
drawBox :: Maybe Glyph -> Maybe Glyph -> Update ()
drawBox v h = drawBorder v v h h Nothing Nothing Nothing Nothing
drawLineH :: Maybe Glyph -> Integer -> Update ()
drawLineH g n = withWindow_ "drawLineH" $ \win ->
withGlyph g $ \pChar ->
whline_set win pChar (fromInteger n)
drawLineV :: Maybe Glyph -> Integer -> Update ()
drawLineV g n = withWindow_ "drawLineV" $ \win ->
withGlyph g $ \pChar ->
wvline_set win pChar (fromInteger n)
setBackground :: Glyph -> Update ()
setBackground g = withWindow_ "setBackground" $ \win ->
withGlyph (Just g) $ \pChar ->
wbkgrndset win pChar >> return 0
data Attribute
= AttributeStandout
| AttributeUnderline
| AttributeReverse
| AttributeBlink
| AttributeDim
| AttributeBold
| AttributeAltCharset
| AttributeInvisible
| AttributeProtect
deriving (Show, Eq)
attrEnum :: E.Attribute -> AttrT
attrEnum = fromInteger . E.fromEnum
attrToInt :: Attribute -> AttrT
attrToInt x = case x of
AttributeStandout -> attrEnum E.WA_STANDOUT
AttributeUnderline -> attrEnum E.WA_UNDERLINE
AttributeReverse -> attrEnum E.WA_REVERSE
AttributeBlink -> attrEnum E.WA_BLINK
AttributeDim -> attrEnum E.WA_DIM
AttributeBold -> attrEnum E.WA_BOLD
AttributeAltCharset -> attrEnum E.WA_ALTCHARSET
AttributeInvisible -> attrEnum E.WA_INVIS
AttributeProtect -> attrEnum E.WA_PROTECT
setAttribute :: Attribute -> Bool -> Update ()
setAttribute attr on = withWindow_ "setAttribute" $ \win ->
let c = if on then wattr_on else wattr_off in
c win (attrToInt attr) nullPtr
setAttributes :: [Attribute] -> Update ()
setAttributes attrs = withWindow_ "setAttributes" $ \win ->
let cint = foldl' (\acc a -> acc .|. attrToInt a) 0 attrs in
alloca $ \pPair -> do
wattr_get win nullPtr pPair nullPtr >>= checkRC "setAttributes"
colorPair <- peek pPair
wattr_set win cint colorPair nullPtr
data Color
= ColorBlack
| ColorRed
| ColorGreen
| ColorYellow
| ColorBlue
| ColorMagenta
| ColorCyan
| ColorWhite
deriving (Show, Eq)
newtype ColorID = ColorID CShort
deriving (Show, Eq)
colorEnum :: E.Color -> CShort
colorEnum = fromInteger . E.fromEnum
colorToShort :: Color -> CShort
colorToShort x = case x of
ColorBlack -> colorEnum E.COLOR_BLACK
ColorRed -> colorEnum E.COLOR_RED
ColorGreen -> colorEnum E.COLOR_GREEN
ColorYellow -> colorEnum E.COLOR_YELLOW
ColorBlue -> colorEnum E.COLOR_BLUE
ColorMagenta -> colorEnum E.COLOR_MAGENTA
ColorCyan -> colorEnum E.COLOR_CYAN
ColorWhite -> colorEnum E.COLOR_WHITE
supportsColor :: Curses Bool
supportsColor = Curses (fmap cToBool has_colors)
canDefineColor :: Curses Bool
canDefineColor = Curses (fmap cToBool can_change_color)
defineColor :: Color
-> Integer
-> Integer
-> Integer
-> Curses ()
defineColor c r g b = Curses $ do
rc <- init_color
(colorToShort c)
(fromInteger r)
(fromInteger g)
(fromInteger b)
checkRC "defineColor" rc
queryColor :: Color -> Curses (Integer, Integer, Integer)
queryColor c = Curses $
alloca $ \pRed ->
alloca $ \pGreen ->
alloca $ \pBlue -> do
rc <- color_content (colorToShort c) pRed pGreen pBlue
checkRC "queryColor" rc
red <- fmap toInteger (peek pRed)
green <- fmap toInteger (peek pGreen)
blue <- fmap toInteger (peek pBlue)
return (red, green, blue)
defaultColorID :: ColorID
defaultColorID = ColorID 0
newColorID :: Color
-> Color
-> Integer
-> Curses ColorID
newColorID fg bg n = Curses $ do
unless (n > 0) $ error "newColorID: n must be > 0"
maxColor <- unCurses maxColorID
unless (n <= maxColor) $ error "newColorID: n must be <= maxColorID"
checkRC "newColorID" =<< init_pair
(fromInteger n)
(colorToShort fg)
(colorToShort bg)
return (ColorID (fromInteger n))
setColorID :: Color
-> Color
-> ColorID
-> Curses ()
setColorID fg bg (ColorID n) = Curses $
checkRC "setColorID" =<< init_pair n
(colorToShort fg)
(colorToShort bg)
maxColorID :: Curses Integer
maxColorID = Curses $ do
pairs <- toInteger `fmap` peek c_COLOR_PAIRS
return (pairs 1)
foreign import ccall "static &COLOR_PAIRS"
c_COLOR_PAIRS :: Ptr CInt
data Glyph = Glyph
{ glyphCharacter :: Char
, glyphAttributes :: [Attribute]
}
deriving (Show, Eq)
withGlyph :: Maybe Glyph -> (CCharT -> IO a) -> IO a
withGlyph Nothing io = io (CCharT nullPtr)
withGlyph (Just (Glyph char attrs)) io =
let cAttrs = foldl' (\acc a -> acc .|. attrToInt a) 0 attrs in
allocaBytes 24 $ \pBuf -> do
void $ memset (castPtr pBuf) 0 24
(\ptr val -> do {pokeByteOff ptr 0 (val::CULong)}) pBuf cAttrs
(\ptr val -> do {pokeByteOff ptr 4 (val::(CWString))}) pBuf (wordPtrToPtr (fromIntegral (ord char)))
io (CCharT pBuf)
glyphCornerUL :: Glyph
glyphCornerUL = Glyph '\x250C' []
glyphCornerLL :: Glyph
glyphCornerLL = Glyph '\x2514' []
glyphCornerUR :: Glyph
glyphCornerUR = Glyph '\x2510' []
glyphCornerLR :: Glyph
glyphCornerLR = Glyph '\x2518' []
glyphTeeL :: Glyph
glyphTeeL = Glyph '\x251C' []
glyphTeeR :: Glyph
glyphTeeR = Glyph '\x2524' []
glyphTeeB :: Glyph
glyphTeeB = Glyph '\x2534' []
glyphTeeT :: Glyph
glyphTeeT = Glyph '\x252C' []
glyphLineH :: Glyph
glyphLineH = Glyph '\x2500' []
glyphLineV :: Glyph
glyphLineV = Glyph '\x2502' []
glyphPlus :: Glyph
glyphPlus = Glyph '\x253C' []
glyphScan1 :: Glyph
glyphScan1 = Glyph '\x23BA' []
glyphScan9 :: Glyph
glyphScan9 = Glyph '\x23BD' []
glyphDiamond :: Glyph
glyphDiamond = Glyph '\x25C6' []
glyphStipple :: Glyph
glyphStipple = Glyph '\x2592' []
glyphDegree :: Glyph
glyphDegree = Glyph '\xb0' []
glyphPlusMinus :: Glyph
glyphPlusMinus = Glyph '\xb1' []
glyphBullet :: Glyph
glyphBullet = Glyph '\xb7' []
glyphArrowL :: Glyph
glyphArrowL = Glyph '\x2190' []
glyphArrowR :: Glyph
glyphArrowR = Glyph '\x2192' []
glyphArrowD :: Glyph
glyphArrowD = Glyph '\x2193' []
glyphArrowU :: Glyph
glyphArrowU = Glyph '\x2191' []
glyphBoard :: Glyph
glyphBoard = Glyph '\x2592' []
glyphLantern :: Glyph
glyphLantern = Glyph '\x2603' []
glyphBlock :: Glyph
glyphBlock = Glyph '\x25AE' []
glyphS3 :: Glyph
glyphS3 = Glyph '\x23BB' []
glyphS7 :: Glyph
glyphS7 = Glyph '\x23BC' []
glyphNE :: Glyph
glyphNE = Glyph '\x2260' []
glyphLTE :: Glyph
glyphLTE = Glyph '\x2264' []
glyphGTE :: Glyph
glyphGTE = Glyph '\x2265' []
glyphPi :: Glyph
glyphPi = Glyph '\x3c0' []
glyphSterling :: Glyph
glyphSterling = Glyph '\xa3' []
data Event
= EventCharacter Char
| EventSpecialKey Key
| EventMouse Integer MouseState
| EventResized
| EventUnknown Integer
deriving (Show, Eq)
getEvent :: Window
-> Maybe Integer
-> Curses (Maybe Event)
getEvent win timeout = Curses io where
io = alloca $ \ptr -> do
wtimeout win $ case timeout of
Nothing -> 1
Just n | n <= 0 -> 0
Just n -> fromInteger n
rc <- wget_wch win ptr
if toInteger rc == E.fromEnum E.ERR
then return Nothing
else fmap Just (parseCode ptr rc)
parseCode ptr rc = do
code <- toInteger `fmap` peek ptr
if rc == 0
then return (charEvent code)
else if code == E.fromEnum E.KEY_MOUSE
then mouseEvent
else if code == E.fromEnum E.KEY_RESIZE
then return EventResized
else keyEvent code
charEvent = EventCharacter . chr . fromInteger
mouseEvent = allocaBytes 20 $ \pEv -> do
getmouse pEv >>= checkRC "getEvent"
evID <- fmap toInteger ((\ptr -> do {peekByteOff ptr 0 ::IO CShort}) pEv)
x <- fmap toInteger ((\ptr -> do {peekByteOff ptr 4 ::IO CInt}) pEv)
y <- fmap toInteger ((\ptr -> do {peekByteOff ptr 8 ::IO CInt}) pEv)
z <- fmap toInteger ((\ptr -> do {peekByteOff ptr 12 ::IO CInt}) pEv)
mask <- (\ptr -> do {peekByteOff ptr 16 ::IO CULong}) pEv
let state = parseMouseState mask
return (EventMouse evID (state { mouseCoordinates = (x, y, z) }))
codeF0 = E.fromEnum E.KEY_F0
codeF64 = codeF0 + 64
keyEvent code = return $ if code >= codeF0 && code <= codeF64
then EventSpecialKey (KeyFunction (code codeF0))
else case M.lookup code keyMap of
Just key -> EventSpecialKey key
Nothing -> EventUnknown code
data Key
= KeyUpArrow
| KeyDownArrow
| KeyLeftArrow
| KeyRightArrow
| KeyHome
| KeyBackspace
| KeyFunction Integer
| KeyDeleteLine
| KeyInsertLine
| KeyDeleteCharacter
| KeyInsertCharacter
| KeyEIC
| KeyClear
| KeyEOS
| KeyEOL
| KeyScrollForward
| KeyScrollBackward
| KeyNextPage
| KeyPreviousPage
| KeySetTab
| KeyClearTab
| KeyClearAllTabs
| KeyEnter
| KeyPrint
| KeyHomeDown
| KeyA1
| KeyA3
| KeyB2
| KeyC1
| KeyC3
| KeyBackTab
| KeyBegin
| KeyCancel
| KeyClose
| KeyCommand
| KeyCopy
| KeyCreate
| KeyEnd
| KeyExit
| KeyFind
| KeyHelp
| KeyMark
| KeyMessage
| KeyMove
| KeyNext
| KeyOpen
| KeyOptions
| KeyPrevious
| KeyRedo
| KeyReference
| KeyRefresh
| KeyReplace
| KeyRestart
| KeyResume
| KeySave
| KeyShiftedBegin
| KeyShiftedCancel
| KeyShiftedCommand
| KeyShiftedCopy
| KeyShiftedCreate
| KeyShiftedDeleteCharacter
| KeyShiftedDeleteLine
| KeySelect
| KeyShiftedEnd
| KeyShiftedEOL
| KeyShiftedExit
| KeyShiftedFind
| KeyShiftedHelp
| KeyShiftedHome
| KeyShiftedInsertCharacter
| KeyShiftedLeftArrow
| KeyShiftedMessage
| KeyShiftedMove
| KeyShiftedNext
| KeyShiftedOptions
| KeyShiftedPrevious
| KeyShiftedPrint
| KeyShiftedRedo
| KeyShiftedReplace
| KeyShiftedRightArrow
| KeyShiftedResume
| KeyShiftedSave
| KeyShiftedSuspend
| KeyShiftedUndo
| KeySuspend
| KeyUndo
deriving (Show, Eq)
keyMap :: M.Map Integer Key
keyMap = M.fromList $ map (\(enum, key) -> (E.fromEnum enum, key))
[ (E.KEY_DOWN, KeyDownArrow)
, (E.KEY_UP, KeyUpArrow)
, (E.KEY_LEFT, KeyLeftArrow)
, (E.KEY_RIGHT, KeyRightArrow)
, (E.KEY_HOME, KeyHome)
, (E.KEY_BACKSPACE, KeyBackspace)
, (E.KEY_DL, KeyDeleteLine)
, (E.KEY_IL, KeyInsertLine)
, (E.KEY_DC, KeyDeleteCharacter)
, (E.KEY_IC, KeyInsertCharacter)
, (E.KEY_EIC, KeyEIC)
, (E.KEY_CLEAR, KeyClear)
, (E.KEY_EOS, KeyEOS)
, (E.KEY_EOL, KeyEOL)
, (E.KEY_SF, KeyScrollForward)
, (E.KEY_SR, KeyScrollBackward)
, (E.KEY_NPAGE, KeyNextPage)
, (E.KEY_PPAGE, KeyPreviousPage)
, (E.KEY_STAB, KeySetTab)
, (E.KEY_CTAB, KeyClearTab)
, (E.KEY_CATAB, KeyClearAllTabs)
, (E.KEY_ENTER, KeyEnter)
, (E.KEY_PRINT, KeyPrint)
, (E.KEY_LL, KeyHomeDown)
, (E.KEY_A1, KeyA1)
, (E.KEY_A3, KeyA3)
, (E.KEY_B2, KeyB2)
, (E.KEY_C1, KeyC1)
, (E.KEY_C3, KeyC3)
, (E.KEY_BTAB, KeyBackTab)
, (E.KEY_BEG, KeyBegin)
, (E.KEY_CANCEL, KeyCancel)
, (E.KEY_CLOSE, KeyClose)
, (E.KEY_COMMAND, KeyCommand)
, (E.KEY_COPY, KeyCopy)
, (E.KEY_CREATE, KeyCreate)
, (E.KEY_END, KeyEnd)
, (E.KEY_EXIT, KeyExit)
, (E.KEY_FIND, KeyFind)
, (E.KEY_HELP, KeyHelp)
, (E.KEY_MARK, KeyMark)
, (E.KEY_MESSAGE, KeyMessage)
, (E.KEY_MOVE, KeyMove)
, (E.KEY_NEXT, KeyNext)
, (E.KEY_OPEN, KeyOpen)
, (E.KEY_OPTIONS, KeyOptions)
, (E.KEY_PREVIOUS, KeyPrevious)
, (E.KEY_REDO, KeyRedo)
, (E.KEY_REFERENCE, KeyReference)
, (E.KEY_REFRESH, KeyRefresh)
, (E.KEY_REPLACE, KeyReplace)
, (E.KEY_RESTART, KeyRestart)
, (E.KEY_RESUME, KeyResume)
, (E.KEY_SAVE, KeySave)
, (E.KEY_SBEG, KeyShiftedBegin)
, (E.KEY_SCANCEL, KeyShiftedCancel)
, (E.KEY_SCOMMAND, KeyShiftedCommand)
, (E.KEY_SCOPY, KeyShiftedCopy)
, (E.KEY_SCREATE, KeyShiftedCreate)
, (E.KEY_SDC, KeyShiftedDeleteCharacter)
, (E.KEY_SDL, KeyShiftedDeleteLine)
, (E.KEY_SELECT, KeySelect)
, (E.KEY_SEND, KeyShiftedEnd)
, (E.KEY_SEOL, KeyShiftedEOL)
, (E.KEY_SEXIT, KeyShiftedExit)
, (E.KEY_SFIND, KeyShiftedFind)
, (E.KEY_SHELP, KeyShiftedHelp)
, (E.KEY_SHOME, KeyShiftedHome)
, (E.KEY_SIC, KeyShiftedInsertCharacter)
, (E.KEY_SLEFT, KeyShiftedLeftArrow)
, (E.KEY_SMESSAGE, KeyShiftedMessage)
, (E.KEY_SMOVE, KeyShiftedMove)
, (E.KEY_SNEXT, KeyShiftedNext)
, (E.KEY_SOPTIONS, KeyShiftedOptions)
, (E.KEY_SPREVIOUS, KeyShiftedPrevious)
, (E.KEY_SPRINT, KeyShiftedPrint)
, (E.KEY_SREDO, KeyShiftedRedo)
, (E.KEY_SREPLACE, KeyShiftedReplace)
, (E.KEY_SRIGHT, KeyShiftedRightArrow)
, (E.KEY_SRSUME, KeyShiftedResume)
, (E.KEY_SSAVE, KeyShiftedSave)
, (E.KEY_SSUSPEND, KeyShiftedSuspend)
, (E.KEY_SUNDO, KeyShiftedUndo)
, (E.KEY_SUSPEND, KeySuspend)
, (E.KEY_UNDO, KeyUndo)
]
data ButtonState
= ButtonPressed
| ButtonReleased
| ButtonClicked
| ButtonDoubleClicked
| ButtonTripleClicked
deriving (Show, Eq)
data MouseState = MouseState
{ mouseCoordinates :: (Integer, Integer, Integer)
, mouseButtons :: [(Integer, ButtonState)]
, mouseAlt :: Bool
, mouseShift :: Bool
, mouseControl :: Bool
}
deriving (Show, Eq)
parseMouseState :: MMaskT -> MouseState
parseMouseState mask = MouseState (0, 0, 0) buttons alt shift ctrl where
maskI = toInteger mask
test e = (maskI .&. (E.fromEnum e)) > 0
alt = test E.BUTTON_ALT
shift = test E.BUTTON_SHIFT
ctrl = test E.BUTTON_CTRL
buttons = catMaybes [button1, button2, button3, button4, button5]
testButton idx r p c dc tc
| test r = Just (idx, ButtonReleased)
| test p = Just (idx, ButtonPressed)
| test c = Just (idx, ButtonClicked)
| test dc = Just (idx, ButtonDoubleClicked)
| test tc = Just (idx, ButtonTripleClicked)
| otherwise = Nothing
button1 = testButton 1
E.BUTTON1_RELEASED
E.BUTTON1_PRESSED
E.BUTTON1_CLICKED
E.BUTTON1_DOUBLE_CLICKED
E.BUTTON1_TRIPLE_CLICKED
button2 = testButton 2
E.BUTTON2_RELEASED
E.BUTTON2_PRESSED
E.BUTTON2_CLICKED
E.BUTTON2_DOUBLE_CLICKED
E.BUTTON2_TRIPLE_CLICKED
button3 = testButton 3
E.BUTTON3_RELEASED
E.BUTTON3_PRESSED
E.BUTTON3_CLICKED
E.BUTTON3_DOUBLE_CLICKED
E.BUTTON3_TRIPLE_CLICKED
button4 = testButton 4
E.BUTTON4_RELEASED
E.BUTTON4_PRESSED
E.BUTTON4_CLICKED
E.BUTTON4_DOUBLE_CLICKED
E.BUTTON4_TRIPLE_CLICKED
button5 = Nothing
data CursorMode
= CursorInvisible
| CursorVisible
| CursorVeryVisible
| CursorModeUnknown CInt
deriving (Eq, Show)
setCursorMode :: CursorMode -> Curses CursorMode
setCursorMode mode = Curses $ do
let intMode = case mode of
CursorInvisible -> 0
CursorVisible -> 1
CursorVeryVisible -> 2
CursorModeUnknown n -> n
rc <- curs_set intMode
checkRC "setCursorMode" rc
return $ case rc of
0 -> CursorInvisible
1 -> CursorVisible
2 -> CursorVeryVisible
_ -> CursorModeUnknown rc
setRaw :: Bool -> Curses ()
setRaw set = Curses (io >>= checkRC "setRaw") where
io = if set then raw else noraw
setCBreak :: Bool -> Curses ()
setCBreak set = Curses (io >>= checkRC "setCBreak") where
io = if set then cbreak else nocbreak
setEcho :: Bool -> Curses ()
setEcho set = Curses (io >>= checkRC "setEcho") where
io = if set then echo else noecho
baudrate :: Curses Integer
baudrate = Curses $ do
rc <- c_baudrate
checkRC "baudrate" rc
return (toInteger rc)
beep :: Curses ()
beep = Curses (c_beep >>= checkRC "beep")
flash :: Curses ()
flash = Curses (c_flash >>= checkRC "flash")
hasMouse :: Curses Bool
hasMouse = Curses (fmap cToBool c_hasMouse)
foreign import ccall unsafe "hsncurses_has_mouse"
c_hasMouse :: IO CInt
enclosed :: Window
-> Integer
-> Integer
-> Curses Bool
enclosed win y x = Curses . fmap cToBool $
wenclose win (fromInteger y) (fromInteger x)
screenSize :: Curses (Integer, Integer)
screenSize = Curses $ do
rows <- peek c_LINES
cols <- peek c_COLS
return (toInteger rows, toInteger cols)
foreign import ccall "static &LINES"
c_LINES :: Ptr CInt
foreign import ccall "static &COLS"
c_COLS :: Ptr CInt
setTouched :: Bool -> Update ()
setTouched touched = withWindow_ "setTouched" $ if touched
then touchwin
else untouchwin
setRowsTouched :: Bool
-> Integer
-> Integer
-> Update ()
setRowsTouched touched start count = withWindow_ "setRowsTouched" $ \win ->
wtouchln win
(fromInteger start)
(fromInteger count)
(cFromBool touched)
setKeypad :: Window -> Bool -> Curses ()
setKeypad win set = Curses (io >>= checkRC "setKeypad") where
io = keypad win (cFromBool set)
getCursor :: Window -> Curses (Integer, Integer)
getCursor win = Curses $ do
row <- getcury win
col <- getcurx win
return (toInteger row, toInteger col)
withWindow :: (Window -> IO a) -> Update a
withWindow io = Update (R.ReaderT (\win -> Curses (io win)))
withWindow_ :: String -> (Window -> IO CInt) -> Update ()
withWindow_ name io = withWindow $ \win -> io win >>= checkRC name
foreign import ccall safe "UI/NCurses.chs.h endwin"
endwin :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h initscr"
initscr :: (IO (Window))
foreign import ccall safe "UI/NCurses.chs.h cbreak"
cbreak :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h mousemask"
mousemask :: (CULong -> ((Ptr CULong) -> (IO CULong)))
foreign import ccall safe "UI/NCurses.chs.h has_colors"
has_colors :: (IO CUChar)
foreign import ccall safe "UI/NCurses.chs.h start_color"
start_color :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h use_default_colors"
use_default_colors :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h keypad"
keypad :: ((Window) -> (CUChar -> (IO CInt)))
foreign import ccall safe "UI/NCurses.chs.h meta"
meta :: ((Window) -> (CUChar -> (IO CInt)))
foreign import ccall safe "UI/NCurses.chs.h wtimeout"
wtimeout :: ((Window) -> (CInt -> (IO ())))
foreign import ccall safe "UI/NCurses.chs.h newwin"
newwin :: (CInt -> (CInt -> (CInt -> (CInt -> (IO (Window))))))
foreign import ccall safe "UI/NCurses.chs.h delwin"
delwin :: ((Window) -> (IO CInt))
foreign import ccall safe "UI/NCurses.chs.h dupwin"
dupwin :: ((Window) -> (IO (Window)))
foreign import ccall safe "UI/NCurses.chs.h wnoutrefresh"
wnoutrefresh :: ((Window) -> (IO CInt))
foreign import ccall safe "UI/NCurses.chs.h doupdate"
doupdate :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h wcolor_set"
wcolor_set :: ((Window) -> (CShort -> ((Ptr ()) -> (IO CInt))))
foreign import ccall safe "UI/NCurses.chs.h wmove"
wmove :: ((Window) -> (CInt -> (CInt -> (IO CInt))))
foreign import ccall safe "UI/NCurses.chs.h waddwstr"
waddwstr :: ((Window) -> ((CWString) -> (IO CInt)))
foreign import ccall safe "UI/NCurses.chs.h wborder_set"
wborder_set :: ((Window) -> ((CCharT) -> ((CCharT) -> ((CCharT) -> ((CCharT) -> ((CCharT) -> ((CCharT) -> ((CCharT) -> ((CCharT) -> (IO CInt))))))))))
foreign import ccall safe "UI/NCurses.chs.h whline_set"
whline_set :: ((Window) -> ((CCharT) -> (CInt -> (IO CInt))))
foreign import ccall safe "UI/NCurses.chs.h wvline_set"
wvline_set :: ((Window) -> ((CCharT) -> (CInt -> (IO CInt))))
foreign import ccall safe "UI/NCurses.chs.h wbkgrndset"
wbkgrndset :: ((Window) -> ((CCharT) -> (IO ())))
foreign import ccall safe "UI/NCurses.chs.h wattr_on"
wattr_on :: ((Window) -> (CULong -> ((Ptr ()) -> (IO CInt))))
foreign import ccall safe "UI/NCurses.chs.h wattr_off"
wattr_off :: ((Window) -> (CULong -> ((Ptr ()) -> (IO CInt))))
foreign import ccall safe "UI/NCurses.chs.h wattr_get"
wattr_get :: ((Window) -> ((Ptr CULong) -> ((Ptr CShort) -> ((Ptr ()) -> (IO CInt)))))
foreign import ccall safe "UI/NCurses.chs.h wattr_set"
wattr_set :: ((Window) -> (CULong -> (CShort -> ((Ptr ()) -> (IO CInt)))))
foreign import ccall safe "UI/NCurses.chs.h can_change_color"
can_change_color :: (IO CUChar)
foreign import ccall safe "UI/NCurses.chs.h init_color"
init_color :: (CShort -> (CShort -> (CShort -> (CShort -> (IO CInt)))))
foreign import ccall safe "UI/NCurses.chs.h color_content"
color_content :: (CShort -> ((Ptr CShort) -> ((Ptr CShort) -> ((Ptr CShort) -> (IO CInt)))))
foreign import ccall safe "UI/NCurses.chs.h init_pair"
init_pair :: (CShort -> (CShort -> (CShort -> (IO CInt))))
foreign import ccall safe "UI/NCurses.chs.h memset"
memset :: ((Ptr ()) -> (CInt -> (CUInt -> (IO (Ptr ())))))
foreign import ccall safe "UI/NCurses.chs.h wget_wch"
wget_wch :: ((Window) -> ((Ptr CUInt) -> (IO CInt)))
foreign import ccall safe "UI/NCurses.chs.h getmouse"
getmouse :: ((Ptr ()) -> (IO CInt))
foreign import ccall safe "UI/NCurses.chs.h curs_set"
curs_set :: (CInt -> (IO CInt))
foreign import ccall safe "UI/NCurses.chs.h raw"
raw :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h noraw"
noraw :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h nocbreak"
nocbreak :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h echo"
echo :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h noecho"
noecho :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h baudrate"
c_baudrate :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h beep"
c_beep :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h flash"
c_flash :: (IO CInt)
foreign import ccall safe "UI/NCurses.chs.h wenclose"
wenclose :: ((Window) -> (CInt -> (CInt -> (IO CUChar))))
foreign import ccall safe "UI/NCurses.chs.h touchwin"
touchwin :: ((Window) -> (IO CInt))
foreign import ccall safe "UI/NCurses.chs.h untouchwin"
untouchwin :: ((Window) -> (IO CInt))
foreign import ccall safe "UI/NCurses.chs.h wtouchln"
wtouchln :: ((Window) -> (CInt -> (CInt -> (CInt -> (IO CInt)))))
foreign import ccall safe "UI/NCurses.chs.h getcury"
getcury :: ((Window) -> (IO CInt))
foreign import ccall safe "UI/NCurses.chs.h getcurx"
getcurx :: ((Window) -> (IO CInt))