{-# LINE 1 "lib/UI/NCurses.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module UI.NCurses
(
Curses
, Update
, Window
, CursesException
, runCurses
, defaultWindow
, newWindow
, closeWindow
, cloneWindow
, moveWindow
, windowPosition
, resizeWindow
, windowSize
, updateWindow
, OverlayMode(..)
, overlay
, copyWindow
, Pad
, newPad
, closePad
, updatePad
, moveCursor
, cursorPosition
, getCursor
, render
, setColor
, drawString
, drawText
, drawGlyph
, drawBorder
, drawBox
, drawLineH
, drawLineV
, clear
, clearLine
, setBackground
, Attribute (..)
, setAttribute
, setAttributes
, Color (..)
, maxColor
, 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
, tryCurses
, catchCurses
, throwCurses
, setRaw
, setCBreak
, setEcho
, baudrate
, beep
, flash
, hasMouse
, enclosed
, screenSize
, setTouched
, setRowsTouched
, setKeypad
, resizeTerminal
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp
import qualified System.IO.Unsafe as C2HSImp
import Control.Exception (bracket_, catch, throwIO, try)
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, void)
import Foreign.C
import qualified UI.NCurses.Enums as E
import UI.NCurses.Compat
import UI.NCurses.Types
{-# LINE 198 "lib/UI/NCurses.chs" #-}
newtype CCharT = CCharT (C2HSImp.Ptr (CCharT))
{-# LINE 199 "lib/UI/NCurses.chs" #-}
{-# LINE 200 "lib/UI/NCurses.chs" #-}
type AttrT = (C2HSImp.CUInt)
{-# LINE 202 "lib/UI/NCurses.chs" #-}
type MMaskT = (C2HSImp.CUInt)
{-# LINE 203 "lib/UI/NCurses.chs" #-}
runCurses :: Curses a -> IO a
runCurses :: Curses a -> IO a
runCurses = IO () -> IO CInt -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ IO ()
initCurses IO CInt
endwin (IO a -> IO a) -> (Curses a -> IO a) -> Curses a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curses a -> IO a
forall a. Curses a -> IO a
unCurses where
allEvents :: CUInt
allEvents = Integer -> CUInt
forall a. Num a => Integer -> a
fromInteger (EnumWrapper -> Integer
forall a. Enum a => a -> Integer
E.fromEnum EnumWrapper
E.ALL_MOUSE_EVENTS)
initCurses :: IO ()
initCurses = do
IO Window -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO Window
initscr
{-# LINE 214 "lib/UI/NCurses.chs" #-}
void cbreak
{-# LINE 215 "lib/UI/NCurses.chs" #-}
void $ mousemask allEvents nullPtr
hasColor <- has_colors
{-# LINE 217 "lib/UI/NCurses.chs" #-}
when (hasColor == 1) $ do
void start_color
{-# LINE 219 "lib/UI/NCurses.chs" #-}
void use_default_colors
{-# LINE 220 "lib/UI/NCurses.chs" #-}
stdscr <- peek c_stdscr
void $ keypad (Window stdscr) 1
void $ meta (Window stdscr) 1
wtimeout (Window stdscr) (- 1)
defaultWindow :: Curses Window
defaultWindow :: Curses Window
defaultWindow = IO Window -> Curses Window
forall a. IO a -> Curses a
Curses (Ptr Window -> Window
Window (Ptr Window -> Window) -> IO (Ptr Window) -> IO Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr (Ptr Window) -> IO (Ptr Window)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Window)
c_stdscr)
foreign import ccall "static &stdscr"
c_stdscr :: Ptr (Ptr Window)
newWindow :: Integer
-> Integer
-> Integer
-> Integer
-> Curses Window
newWindow :: Integer -> Integer -> Integer -> Integer -> Curses Window
newWindow rows :: Integer
rows cols :: Integer
cols x :: Integer
x y :: Integer
y = IO Window -> Curses Window
forall a. IO a -> Curses a
Curses (IO Window -> Curses Window) -> IO Window -> Curses Window
forall a b. (a -> b) -> a -> b
$ do
Window
win <- CInt -> CInt -> CInt -> CInt -> IO Window
newwin
{-# LINE 246 "lib/UI/NCurses.chs" #-}
(fromInteger rows)
(fromInteger cols)
(fromInteger x)
(fromInteger y)
if windowPtr win == nullPtr
then throwIO (CursesException "newWindow: newwin() returned NULL")
else do
void $ keypad win 1
void $ meta win 1
wtimeout win (- 1)
return win
closeWindow :: Window -> Curses ()
closeWindow :: Window -> Curses ()
closeWindow win :: Window
win = IO () -> Curses ()
forall a. IO a -> Curses a
Curses (Window -> IO CInt
delwin Window
win IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "closeWindow")
cloneWindow :: Window -> Curses Window
cloneWindow :: Window -> Curses Window
cloneWindow old :: Window
old = IO Window -> Curses Window
forall a. IO a -> Curses a
Curses (IO Window -> Curses Window) -> IO Window -> Curses Window
forall a b. (a -> b) -> a -> b
$ do
Window
win <- Window -> IO Window
dupwin Window
old
if Window -> Ptr Window
windowPtr Window
win Ptr Window -> Ptr Window -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Window
forall a. Ptr a
nullPtr
then CursesException -> IO Window
forall e a. Exception e => e -> IO a
throwIO (String -> CursesException
CursesException "cloneWindow: dupwin() returned NULL")
else Window -> IO Window
forall (m :: * -> *) a. Monad m => a -> m a
return Window
win
updateWindow :: Window -> Update a -> Curses a
updateWindow :: Window -> Update a -> Curses a
updateWindow win :: Window
win (Update reader :: ReaderT Window Curses a
reader) = do
a
a <- ReaderT Window Curses a -> Window -> Curses a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT ReaderT Window Curses a
reader Window
win
IO () -> Curses ()
forall a. IO a -> Curses a
Curses (Window -> IO CInt
wnoutrefresh Window
win IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "updateWindow")
a -> Curses a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
moveWindow :: Integer -> Integer -> Update ()
moveWindow :: Integer -> Integer -> Update ()
moveWindow row :: Integer
row col :: Integer
col = String -> (Window -> IO CInt) -> Update ()
withWindow_ "moveWindow" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
Window -> CInt -> CInt -> IO CInt
mvwin Window
win (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
row) (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
col)
windowPosition :: Update (Integer, Integer)
windowPosition :: Update (Integer, Integer)
windowPosition = (Window -> IO (Integer, Integer)) -> Update (Integer, Integer)
forall a. (Window -> IO a) -> Update a
withWindow ((Window -> IO (Integer, Integer)) -> Update (Integer, Integer))
-> (Window -> IO (Integer, Integer)) -> Update (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ \win :: Window
win -> do
CInt
row <- Window -> IO CInt
getbegy Window
win
CInt
col <- Window -> IO CInt
getbegx Window
win
(Integer, Integer) -> IO (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
row, CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
col)
resizeWindow :: Integer -> Integer -> Update ()
resizeWindow :: Integer -> Integer -> Update ()
resizeWindow rows :: Integer
rows cols :: Integer
cols = String -> (Window -> IO CInt) -> Update ()
withWindow_ "resizeWindow" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
Window -> CInt -> CInt -> IO CInt
wresize Window
win (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
rows) (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
cols)
windowSize :: Update (Integer, Integer)
windowSize :: Update (Integer, Integer)
windowSize = (Window -> IO (Integer, Integer)) -> Update (Integer, Integer)
forall a. (Window -> IO a) -> Update a
withWindow ((Window -> IO (Integer, Integer)) -> Update (Integer, Integer))
-> (Window -> IO (Integer, Integer)) -> Update (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ \win :: Window
win -> do
CInt
rows <- Window -> IO CInt
getmaxy Window
win
CInt
cols <- Window -> IO CInt
getmaxx Window
win
(Integer, Integer) -> IO (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
rows, CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
cols)
data OverlayMode
= OverlayMerge
| OverlayReplace
deriving (Int -> OverlayMode -> ShowS
[OverlayMode] -> ShowS
OverlayMode -> String
(Int -> OverlayMode -> ShowS)
-> (OverlayMode -> String)
-> ([OverlayMode] -> ShowS)
-> Show OverlayMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OverlayMode] -> ShowS
$cshowList :: [OverlayMode] -> ShowS
show :: OverlayMode -> String
$cshow :: OverlayMode -> String
showsPrec :: Int -> OverlayMode -> ShowS
$cshowsPrec :: Int -> OverlayMode -> ShowS
Show, OverlayMode -> OverlayMode -> Bool
(OverlayMode -> OverlayMode -> Bool)
-> (OverlayMode -> OverlayMode -> Bool) -> Eq OverlayMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OverlayMode -> OverlayMode -> Bool
$c/= :: OverlayMode -> OverlayMode -> Bool
== :: OverlayMode -> OverlayMode -> Bool
$c== :: OverlayMode -> OverlayMode -> Bool
Eq)
overlay :: Window -> OverlayMode -> Update ()
overlay :: Window -> OverlayMode -> Update ()
overlay src :: Window
src mode :: OverlayMode
mode = String -> (Window -> IO CInt) -> Update ()
withWindow_ "overlay" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \dst :: Window
dst -> case OverlayMode
mode of
OverlayMerge -> Window -> Window -> IO CInt
c_overlay Window
src Window
dst
OverlayReplace -> Window -> Window -> IO CInt
overwrite Window
src Window
dst
copyWindow :: Window
-> OverlayMode
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Update ()
copyWindow :: Window
-> OverlayMode
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Update ()
copyWindow src :: Window
src mode :: OverlayMode
mode sminrow :: Integer
sminrow smincol :: Integer
smincol dminrow :: Integer
dminrow dmincol :: Integer
dmincol dmaxrow :: Integer
dmaxrow dmaxcol :: Integer
dmaxcol = String -> (Window -> IO CInt) -> Update ()
withWindow_ "copyWindow" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \dst :: Window
dst -> do
Window
-> Window
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> IO CInt
copywin Window
src Window
dst
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
sminrow)
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
smincol)
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
dminrow)
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
dmincol)
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
dmaxrow)
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
dmaxcol)
(Bool -> CInt
forall a. Integral a => Bool -> a
cFromBool (OverlayMode
mode OverlayMode -> OverlayMode -> Bool
forall a. Eq a => a -> a -> Bool
/= OverlayMode
OverlayReplace))
newtype Pad = Pad Window
newPad :: Integer
-> Integer
-> Curses Pad
newPad :: Integer -> Integer -> Curses Pad
newPad rows :: Integer
rows cols :: Integer
cols = IO Pad -> Curses Pad
forall a. IO a -> Curses a
Curses (IO Pad -> Curses Pad) -> IO Pad -> Curses Pad
forall a b. (a -> b) -> a -> b
$ do
Window
win <- CInt -> CInt -> IO Window
newpad
{-# LINE 360 "lib/UI/NCurses.chs" #-}
(fromInteger rows)
(fromInteger cols)
if windowPtr win == nullPtr
then throwIO (CursesException "newPad: newpad() returned NULL")
else do
void $ keypad win 1
void $ meta win 1
wtimeout win (- 1)
return (Pad win)
closePad :: Pad -> Curses ()
closePad :: Pad -> Curses ()
closePad (Pad win :: Window
win) = IO () -> Curses ()
forall a. IO a -> Curses a
Curses (Window -> IO CInt
delwin Window
win IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "closePad")
updatePad :: Pad
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Update a
-> Curses a
updatePad :: Pad
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Update a
-> Curses a
updatePad (Pad win :: Window
win) pminrow :: Integer
pminrow pmincol :: Integer
pmincol sminrow :: Integer
sminrow smincol :: Integer
smincol smaxrow :: Integer
smaxrow smaxcol :: Integer
smaxcol (Update reader :: ReaderT Window Curses a
reader) = do
a
a <- ReaderT Window Curses a -> Window -> Curses a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT ReaderT Window Curses a
reader Window
win
IO () -> Curses ()
forall a. IO a -> Curses a
Curses (IO () -> Curses ()) -> IO () -> Curses ()
forall a b. (a -> b) -> a -> b
$
(Window -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt
pnoutrefresh Window
win
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
pminrow)
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
pmincol)
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
sminrow)
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
smincol)
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
smaxrow)
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
smaxcol))
IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "updatePad"
a -> Curses a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
moveCursor :: Integer
-> Integer
-> Update ()
moveCursor :: Integer -> Integer -> Update ()
moveCursor row :: Integer
row col :: Integer
col = String -> (Window -> IO CInt) -> Update ()
withWindow_ "moveCursor" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
Window -> CInt -> CInt -> IO CInt
wmove Window
win (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
row) (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
col)
cursorPosition :: Update (Integer, Integer)
cursorPosition :: Update (Integer, Integer)
cursorPosition = (Window -> IO (Integer, Integer)) -> Update (Integer, Integer)
forall a. (Window -> IO a) -> Update a
withWindow ((Window -> IO (Integer, Integer)) -> Update (Integer, Integer))
-> (Window -> IO (Integer, Integer)) -> Update (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ \win :: Window
win -> do
CInt
row <- Window -> IO CInt
getcury Window
win
CInt
col <- Window -> IO CInt
getcurx Window
win
(Integer, Integer) -> IO (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
row, CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
col)
getCursor :: Window -> Curses (Integer, Integer)
getCursor :: Window -> Curses (Integer, Integer)
getCursor win :: Window
win = IO (Integer, Integer) -> Curses (Integer, Integer)
forall a. IO a -> Curses a
Curses (IO (Integer, Integer) -> Curses (Integer, Integer))
-> IO (Integer, Integer) -> Curses (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ do
CInt
row <- Window -> IO CInt
getcury Window
win
CInt
col <- Window -> IO CInt
getcurx Window
win
(Integer, Integer) -> IO (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
row, CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
col)
render :: Curses ()
render :: Curses ()
render = IO () -> Curses ()
forall a. IO a -> Curses a
Curses (IO CInt
doupdate IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "render")
setColor :: ColorID -> Update ()
setColor :: ColorID -> Update ()
setColor (ColorID pair :: CShort
pair) = String -> (Window -> IO CInt) -> Update ()
withWindow_ "setColor" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
Window -> CShort -> Ptr () -> IO CInt
wcolor_set Window
win CShort
pair Ptr ()
forall a. Ptr a
nullPtr
drawString :: String -> Update ()
drawString :: String -> Update ()
drawString str :: String
str = String -> (Window -> IO CInt) -> Update ()
withWindow_ "drawString" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
String -> (CWString -> IO CInt) -> IO CInt
forall a. String -> (CWString -> IO a) -> IO a
withCWString String
str (Window -> CWString -> IO CInt
waddwstr Window
win)
drawText :: T.Text -> Update ()
drawText :: Text -> Update ()
drawText txt :: Text
txt = String -> (Window -> IO CInt) -> Update ()
withWindow_ "drawText" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
String -> (CWString -> IO CInt) -> IO CInt
forall a. String -> (CWString -> IO a) -> IO a
withCWString (Text -> String
T.unpack Text
txt) (Window -> CWString -> IO CInt
waddwstr Window
win)
drawGlyph :: Glyph -> Update ()
drawGlyph :: Glyph -> Update ()
drawGlyph glyph :: Glyph
glyph = String -> (Window -> IO CInt) -> Update ()
withWindow_ "drawGlyph" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
Glyph -> (CCharT -> IO CInt) -> IO CInt
forall a. Glyph -> (CCharT -> IO a) -> IO a
withGlyph Glyph
glyph ((CCharT -> IO CInt) -> IO CInt) -> (CCharT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pGlyph :: CCharT
pGlyph ->
Window -> CCharT -> IO CInt
wadd_wch Window
win CCharT
pGlyph
drawBorder :: Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Update ()
drawBorder :: Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Update ()
drawBorder le :: Maybe Glyph
le re :: Maybe Glyph
re te :: Maybe Glyph
te be :: Maybe Glyph
be tl :: Maybe Glyph
tl tr :: Maybe Glyph
tr bl :: Maybe Glyph
bl br :: Maybe Glyph
br =
String -> (Window -> IO CInt) -> Update ()
withWindow_ "drawBorder" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
Maybe Glyph -> (CCharT -> IO CInt) -> IO CInt
forall a. Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph Maybe Glyph
le ((CCharT -> IO CInt) -> IO CInt) -> (CCharT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pLE :: CCharT
pLE ->
Maybe Glyph -> (CCharT -> IO CInt) -> IO CInt
forall a. Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph Maybe Glyph
re ((CCharT -> IO CInt) -> IO CInt) -> (CCharT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pRE :: CCharT
pRE ->
Maybe Glyph -> (CCharT -> IO CInt) -> IO CInt
forall a. Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph Maybe Glyph
te ((CCharT -> IO CInt) -> IO CInt) -> (CCharT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pTE :: CCharT
pTE ->
Maybe Glyph -> (CCharT -> IO CInt) -> IO CInt
forall a. Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph Maybe Glyph
be ((CCharT -> IO CInt) -> IO CInt) -> (CCharT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pBE :: CCharT
pBE ->
Maybe Glyph -> (CCharT -> IO CInt) -> IO CInt
forall a. Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph Maybe Glyph
tl ((CCharT -> IO CInt) -> IO CInt) -> (CCharT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pTL :: CCharT
pTL ->
Maybe Glyph -> (CCharT -> IO CInt) -> IO CInt
forall a. Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph Maybe Glyph
tr ((CCharT -> IO CInt) -> IO CInt) -> (CCharT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pTR :: CCharT
pTR ->
Maybe Glyph -> (CCharT -> IO CInt) -> IO CInt
forall a. Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph Maybe Glyph
bl ((CCharT -> IO CInt) -> IO CInt) -> (CCharT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pBL :: CCharT
pBL ->
Maybe Glyph -> (CCharT -> IO CInt) -> IO CInt
forall a. Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph Maybe Glyph
br ((CCharT -> IO CInt) -> IO CInt) -> (CCharT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pBR :: CCharT
pBR ->
Window
-> CCharT
-> CCharT
-> CCharT
-> CCharT
-> CCharT
-> CCharT
-> CCharT
-> CCharT
-> IO CInt
wborder_set Window
win CCharT
pLE CCharT
pRE CCharT
pTE CCharT
pBE CCharT
pTL CCharT
pTR CCharT
pBL CCharT
pBR
drawBox :: Maybe Glyph -> Maybe Glyph -> Update ()
drawBox :: Maybe Glyph -> Maybe Glyph -> Update ()
drawBox v :: Maybe Glyph
v h :: Maybe Glyph
h = Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Maybe Glyph
-> Update ()
drawBorder Maybe Glyph
v Maybe Glyph
v Maybe Glyph
h Maybe Glyph
h Maybe Glyph
forall a. Maybe a
Nothing Maybe Glyph
forall a. Maybe a
Nothing Maybe Glyph
forall a. Maybe a
Nothing Maybe Glyph
forall a. Maybe a
Nothing
drawLineH :: Maybe Glyph -> Integer -> Update ()
drawLineH :: Maybe Glyph -> Integer -> Update ()
drawLineH g :: Maybe Glyph
g n :: Integer
n = String -> (Window -> IO CInt) -> Update ()
withWindow_ "drawLineH" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
Maybe Glyph -> (CCharT -> IO CInt) -> IO CInt
forall a. Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph Maybe Glyph
g ((CCharT -> IO CInt) -> IO CInt) -> (CCharT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pChar :: CCharT
pChar ->
Window -> CCharT -> CInt -> IO CInt
whline_set Window
win CCharT
pChar (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
n)
drawLineV :: Maybe Glyph -> Integer -> Update ()
drawLineV :: Maybe Glyph -> Integer -> Update ()
drawLineV g :: Maybe Glyph
g n :: Integer
n = String -> (Window -> IO CInt) -> Update ()
withWindow_ "drawLineV" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
Maybe Glyph -> (CCharT -> IO CInt) -> IO CInt
forall a. Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph Maybe Glyph
g ((CCharT -> IO CInt) -> IO CInt) -> (CCharT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pChar :: CCharT
pChar ->
Window -> CCharT -> CInt -> IO CInt
wvline_set Window
win CCharT
pChar (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
n)
clear :: Update ()
clear :: Update ()
clear = String -> (Window -> IO CInt) -> Update ()
withWindow_ "clear" Window -> IO CInt
wclear
{-# LINE 493 "lib/UI/NCurses.chs" #-}
clearLine :: Update ()
clearLine :: Update ()
clearLine = String -> (Window -> IO CInt) -> Update ()
withWindow_ "clear" Window -> IO CInt
wclrtoeol
{-# LINE 498 "lib/UI/NCurses.chs" #-}
setBackground :: Glyph -> Update ()
setBackground :: Glyph -> Update ()
setBackground g :: Glyph
g = String -> (Window -> IO CInt) -> Update ()
withWindow_ "setBackground" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
Maybe Glyph -> (CCharT -> IO CInt) -> IO CInt
forall a. Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph (Glyph -> Maybe Glyph
forall a. a -> Maybe a
Just Glyph
g) ((CCharT -> IO CInt) -> IO CInt) -> (CCharT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pChar :: CCharT
pChar ->
Window -> CCharT -> IO ()
wbkgrndset Window
win CCharT
pChar IO () -> IO CInt -> IO CInt
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return 0
data Attribute
= AttributeColor ColorID
| AttributeStandout
| AttributeUnderline
| AttributeReverse
| AttributeBlink
| AttributeDim
| AttributeBold
| AttributeAltCharset
| AttributeInvisible
| AttributeProtect
| AttributeHorizontal
| AttributeLeft
| AttributeLow
| AttributeRight
| AttributeTop
| AttributeVertical
deriving (Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show, Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq)
attrEnum :: E.Attribute -> AttrT
attrEnum :: Attribute -> CUInt
attrEnum = Integer -> CUInt
forall a. Num a => Integer -> a
fromInteger (Integer -> CUInt) -> (Attribute -> Integer) -> Attribute -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attribute -> Integer
forall a. Enum a => a -> Integer
E.fromEnum
attrToInt :: Attribute -> AttrT
attrToInt :: Attribute -> CUInt
attrToInt x :: Attribute
x = case Attribute
x of
AttributeStandout -> Attribute -> CUInt
attrEnum Attribute
E.WA_STANDOUT
AttributeUnderline -> Attribute -> CUInt
attrEnum Attribute
E.WA_UNDERLINE
AttributeReverse -> Attribute -> CUInt
attrEnum Attribute
E.WA_REVERSE
AttributeBlink -> Attribute -> CUInt
attrEnum Attribute
E.WA_BLINK
AttributeDim -> Attribute -> CUInt
attrEnum Attribute
E.WA_DIM
AttributeBold -> Attribute -> CUInt
attrEnum Attribute
E.WA_BOLD
AttributeAltCharset -> Attribute -> CUInt
attrEnum Attribute
E.WA_ALTCHARSET
AttributeInvisible -> Attribute -> CUInt
attrEnum Attribute
E.WA_INVIS
AttributeProtect -> Attribute -> CUInt
attrEnum Attribute
E.WA_PROTECT
AttributeHorizontal -> Attribute -> CUInt
attrEnum Attribute
E.WA_HORIZONTAL
AttributeLeft -> Attribute -> CUInt
attrEnum Attribute
E.WA_LEFT
AttributeLow -> Attribute -> CUInt
attrEnum Attribute
E.WA_LOW
AttributeRight -> Attribute -> CUInt
attrEnum Attribute
E.WA_RIGHT
AttributeTop -> Attribute -> CUInt
attrEnum Attribute
E.WA_TOP
AttributeVertical -> Attribute -> CUInt
attrEnum Attribute
E.WA_VERTICAL
AttributeColor (ColorID cid :: CShort
cid) -> CInt -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((\ x1 :: CInt
x1 -> IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO (CInt -> IO CInt
c_COLOR_PAIR CInt
x1)) (CShort -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CShort
cid))
setAttribute :: Attribute -> Bool -> Update ()
setAttribute :: Attribute -> Bool -> Update ()
setAttribute attr :: Attribute
attr on :: Bool
on = String -> (Window -> IO CInt) -> Update ()
withWindow_ "setAttribute" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
let c :: Window -> CUInt -> Ptr () -> IO CInt
c = if Bool
on then Window -> CUInt -> Ptr () -> IO CInt
wattr_on else Window -> CUInt -> Ptr () -> IO CInt
wattr_off in
Window -> CUInt -> Ptr () -> IO CInt
c Window
win (Attribute -> CUInt
attrToInt Attribute
attr) Ptr ()
forall a. Ptr a
nullPtr
setAttributes :: [Attribute] -> Update ()
setAttributes :: [Attribute] -> Update ()
setAttributes attrs :: [Attribute]
attrs = String -> (Window -> IO CInt) -> Update ()
withWindow_ "setAttributes" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
let cint :: CUInt
cint = (CUInt -> Attribute -> CUInt) -> CUInt -> [Attribute] -> CUInt
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\acc :: CUInt
acc a :: Attribute
a -> CUInt
acc CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. Attribute -> CUInt
attrToInt Attribute
a) 0 [Attribute]
attrs in
(Ptr CShort -> IO CInt) -> IO CInt
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CShort -> IO CInt) -> IO CInt)
-> (Ptr CShort -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pPair :: Ptr CShort
pPair -> do
Window -> Ptr CUInt -> Ptr CShort -> Ptr () -> IO CInt
wattr_get Window
win Ptr CUInt
forall a. Ptr a
nullPtr Ptr CShort
pPair Ptr ()
forall a. Ptr a
nullPtr IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "setAttributes"
CShort
colorPair <- Ptr CShort -> IO CShort
forall a. Storable a => Ptr a -> IO a
peek Ptr CShort
pPair
Window -> CUInt -> CShort -> Ptr () -> IO CInt
wattr_set Window
win CUInt
cint CShort
colorPair Ptr ()
forall a. Ptr a
nullPtr
data Color
= ColorBlack
| ColorRed
| ColorGreen
| ColorYellow
| ColorBlue
| ColorMagenta
| ColorCyan
| ColorWhite
| ColorDefault
| Color Int16
deriving (Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show, Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq)
maxColor :: Curses Integer
maxColor :: Curses Integer
maxColor = IO Integer -> Curses Integer
forall a. IO a -> Curses a
Curses (IO Integer -> Curses Integer) -> IO Integer -> Curses Integer
forall a b. (a -> b) -> a -> b
$ do
Integer
count <- CInt -> Integer
forall a. Integral a => a -> Integer
toInteger (CInt -> Integer) -> IO CInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
c_COLORS
Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
count Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)
foreign import ccall "static &COLORS"
c_COLORS :: Ptr CInt
newtype ColorID = ColorID CShort
deriving (Int -> ColorID -> ShowS
[ColorID] -> ShowS
ColorID -> String
(Int -> ColorID -> ShowS)
-> (ColorID -> String) -> ([ColorID] -> ShowS) -> Show ColorID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorID] -> ShowS
$cshowList :: [ColorID] -> ShowS
show :: ColorID -> String
$cshow :: ColorID -> String
showsPrec :: Int -> ColorID -> ShowS
$cshowsPrec :: Int -> ColorID -> ShowS
Show, ColorID -> ColorID -> Bool
(ColorID -> ColorID -> Bool)
-> (ColorID -> ColorID -> Bool) -> Eq ColorID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorID -> ColorID -> Bool
$c/= :: ColorID -> ColorID -> Bool
== :: ColorID -> ColorID -> Bool
$c== :: ColorID -> ColorID -> Bool
Eq)
colorEnum :: E.Color -> CShort
colorEnum :: Color -> CShort
colorEnum = Integer -> CShort
forall a. Num a => Integer -> a
fromInteger (Integer -> CShort) -> (Color -> Integer) -> Color -> CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Integer
forall a. Enum a => a -> Integer
E.fromEnum
colorToShort :: Color -> CShort
colorToShort :: Color -> CShort
colorToShort x :: Color
x = case Color
x of
Color n :: Int16
n -> Int16 -> CShort
CShort Int16
n
ColorBlack -> Color -> CShort
colorEnum Color
E.COLOR_BLACK
ColorRed -> Color -> CShort
colorEnum Color
E.COLOR_RED
ColorGreen -> Color -> CShort
colorEnum Color
E.COLOR_GREEN
ColorYellow -> Color -> CShort
colorEnum Color
E.COLOR_YELLOW
ColorBlue -> Color -> CShort
colorEnum Color
E.COLOR_BLUE
ColorMagenta -> Color -> CShort
colorEnum Color
E.COLOR_MAGENTA
ColorCyan -> Color -> CShort
colorEnum Color
E.COLOR_CYAN
ColorWhite -> Color -> CShort
colorEnum Color
E.COLOR_WHITE
ColorDefault -> Color -> CShort
colorEnum Color
E.COLOR_DEFAULT
supportsColor :: Curses Bool
supportsColor :: Curses Bool
supportsColor = IO Bool -> Curses Bool
forall a. IO a -> Curses a
Curses ((CUChar -> Bool) -> IO CUChar -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUChar -> Bool
forall a. Integral a => a -> Bool
cToBool IO CUChar
has_colors)
canDefineColor :: Curses Bool
canDefineColor :: Curses Bool
canDefineColor = IO Bool -> Curses Bool
forall a. IO a -> Curses a
Curses ((CUChar -> Bool) -> IO CUChar -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUChar -> Bool
forall a. Integral a => a -> Bool
cToBool IO CUChar
can_change_color)
defineColor :: Color
-> Integer
-> Integer
-> Integer
-> Curses ()
defineColor :: Color -> Integer -> Integer -> Integer -> Curses ()
defineColor c :: Color
c r :: Integer
r g :: Integer
g b :: Integer
b = IO () -> Curses ()
forall a. IO a -> Curses a
Curses (IO () -> Curses ()) -> IO () -> Curses ()
forall a b. (a -> b) -> a -> b
$ do
CInt
rc <- CShort -> CShort -> CShort -> CShort -> IO CInt
init_color
{-# LINE 642 "lib/UI/NCurses.chs" #-}
(colorToShort c)
(fromInteger r)
(fromInteger g)
(fromInteger b)
checkRC "defineColor" rc
queryColor :: Color -> Curses (Integer, Integer, Integer)
queryColor :: Color -> Curses (Integer, Integer, Integer)
queryColor c :: Color
c = IO (Integer, Integer, Integer)
-> Curses (Integer, Integer, Integer)
forall a. IO a -> Curses a
Curses (IO (Integer, Integer, Integer)
-> Curses (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer)
-> Curses (Integer, Integer, Integer)
forall a b. (a -> b) -> a -> b
$
(Ptr CShort -> IO (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CShort -> IO (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer))
-> (Ptr CShort -> IO (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer)
forall a b. (a -> b) -> a -> b
$ \pRed :: Ptr CShort
pRed ->
(Ptr CShort -> IO (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CShort -> IO (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer))
-> (Ptr CShort -> IO (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer)
forall a b. (a -> b) -> a -> b
$ \pGreen :: Ptr CShort
pGreen ->
(Ptr CShort -> IO (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CShort -> IO (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer))
-> (Ptr CShort -> IO (Integer, Integer, Integer))
-> IO (Integer, Integer, Integer)
forall a b. (a -> b) -> a -> b
$ \pBlue :: Ptr CShort
pBlue -> do
CInt
rc <- CShort -> Ptr CShort -> Ptr CShort -> Ptr CShort -> IO CInt
color_content (Color -> CShort
colorToShort Color
c) Ptr CShort
pRed Ptr CShort
pGreen Ptr CShort
pBlue
String -> CInt -> IO ()
checkRC "queryColor" CInt
rc
Integer
red <- (CShort -> Integer) -> IO CShort -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CShort -> Integer
forall a. Integral a => a -> Integer
toInteger (Ptr CShort -> IO CShort
forall a. Storable a => Ptr a -> IO a
peek Ptr CShort
pRed)
Integer
green <- (CShort -> Integer) -> IO CShort -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CShort -> Integer
forall a. Integral a => a -> Integer
toInteger (Ptr CShort -> IO CShort
forall a. Storable a => Ptr a -> IO a
peek Ptr CShort
pGreen)
Integer
blue <- (CShort -> Integer) -> IO CShort -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CShort -> Integer
forall a. Integral a => a -> Integer
toInteger (Ptr CShort -> IO CShort
forall a. Storable a => Ptr a -> IO a
peek Ptr CShort
pBlue)
(Integer, Integer, Integer) -> IO (Integer, Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
red, Integer
green, Integer
blue)
defaultColorID :: ColorID
defaultColorID :: ColorID
defaultColorID = CShort -> ColorID
ColorID 0
newColorID :: Color
-> Color
-> Integer
-> Curses ColorID
newColorID :: Color -> Color -> Integer -> Curses ColorID
newColorID fg :: Color
fg bg :: Color
bg n :: Integer
n = IO ColorID -> Curses ColorID
forall a. IO a -> Curses a
Curses (IO ColorID -> Curses ColorID) -> IO ColorID -> Curses ColorID
forall a b. (a -> b) -> a -> b
$ do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ CursesException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (String -> CursesException
CursesException "newColorID: n must be > 0")
Integer
maxColor <- Curses Integer -> IO Integer
forall a. Curses a -> IO a
unCurses Curses Integer
maxColorID
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxColor) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ CursesException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (String -> CursesException
CursesException "newColorID: n must be <= maxColorID")
String -> CInt -> IO ()
checkRC "newColorID" (CInt -> IO ()) -> IO CInt -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CShort -> CShort -> CShort -> IO CInt
init_pair
{-# LINE 679 "lib/UI/NCurses.chs" #-}
(fromInteger n)
(colorToShort fg)
(colorToShort bg)
ColorID -> IO ColorID
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ColorID
ColorID (Integer -> CShort
forall a. Num a => Integer -> a
fromInteger Integer
n))
setColorID :: Color
-> Color
-> ColorID
-> Curses ()
setColorID :: Color -> Color -> ColorID -> Curses ()
setColorID fg :: Color
fg bg :: Color
bg (ColorID n :: CShort
n) = IO () -> Curses ()
forall a. IO a -> Curses a
Curses (IO () -> Curses ()) -> IO () -> Curses ()
forall a b. (a -> b) -> a -> b
$
String -> CInt -> IO ()
checkRC "setColorID" (CInt -> IO ()) -> IO CInt -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CShort -> CShort -> CShort -> IO CInt
init_pair CShort
n
(Color -> CShort
colorToShort Color
fg)
(Color -> CShort
colorToShort Color
bg)
maxColorID :: Curses Integer
maxColorID :: Curses Integer
maxColorID = IO Integer -> Curses Integer
forall a. IO a -> Curses a
Curses (IO Integer -> Curses Integer) -> IO Integer -> Curses Integer
forall a b. (a -> b) -> a -> b
$ do
Integer
pairs <- CInt -> Integer
forall a. Integral a => a -> Integer
toInteger (CInt -> Integer) -> IO CInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
c_COLOR_PAIRS
Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
pairs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)
foreign import ccall "static &COLOR_PAIRS"
c_COLOR_PAIRS :: Ptr CInt
data Glyph = Glyph
{ Glyph -> Char
glyphCharacter :: Char
, Glyph -> [Attribute]
glyphAttributes :: [Attribute]
}
deriving (Int -> Glyph -> ShowS
[Glyph] -> ShowS
Glyph -> String
(Int -> Glyph -> ShowS)
-> (Glyph -> String) -> ([Glyph] -> ShowS) -> Show Glyph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Glyph] -> ShowS
$cshowList :: [Glyph] -> ShowS
show :: Glyph -> String
$cshow :: Glyph -> String
showsPrec :: Int -> Glyph -> ShowS
$cshowsPrec :: Int -> Glyph -> ShowS
Show, Glyph -> Glyph -> Bool
(Glyph -> Glyph -> Bool) -> (Glyph -> Glyph -> Bool) -> Eq Glyph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Glyph -> Glyph -> Bool
$c/= :: Glyph -> Glyph -> Bool
== :: Glyph -> Glyph -> Bool
$c== :: Glyph -> Glyph -> Bool
Eq)
withMaybeGlyph :: Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph :: Maybe Glyph -> (CCharT -> IO a) -> IO a
withMaybeGlyph Nothing io :: CCharT -> IO a
io = CCharT -> IO a
io (Ptr CCharT -> CCharT
CCharT Ptr CCharT
forall a. Ptr a
nullPtr)
withMaybeGlyph (Just g :: Glyph
g) io :: CCharT -> IO a
io = Glyph -> (CCharT -> IO a) -> IO a
forall a. Glyph -> (CCharT -> IO a) -> IO a
withGlyph Glyph
g CCharT -> IO a
io
withGlyph :: Glyph -> (CCharT -> IO a) -> IO a
withGlyph :: Glyph -> (CCharT -> IO a) -> IO a
withGlyph (Glyph char :: Char
char attrs :: [Attribute]
attrs) io :: CCharT -> IO a
io =
let cAttrs :: CUInt
cAttrs = (CUInt -> Attribute -> CUInt) -> CUInt -> [Attribute] -> CUInt
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\acc :: CUInt
acc a :: Attribute
a -> CUInt
acc CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. Attribute -> CUInt
attrToInt Attribute
a) 0 [Attribute]
attrs in
String -> (CWStringLen -> IO a) -> IO a
forall a. String -> (CWStringLen -> IO a) -> IO a
withCWStringLen [Char
char] ((CWStringLen -> IO a) -> IO a) -> (CWStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(cChars :: CWString
cChars, cCharsLen :: Int
cCharsLen) ->
Int -> (Ptr CCharT -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 28 ((Ptr CCharT -> IO a) -> IO a) -> (Ptr CCharT -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \pBuf :: Ptr CCharT
pBuf -> do
CCharT -> CUInt -> CWString -> CULong -> IO ()
hsncurses_init_cchar_t (Ptr CCharT -> CCharT
CCharT Ptr CCharT
pBuf) CUInt
cAttrs CWString
cChars (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cCharsLen)
CCharT -> IO a
io (Ptr CCharT -> CCharT
CCharT Ptr CCharT
pBuf)
glyphCornerUL :: Glyph
glyphCornerUL :: Glyph
glyphCornerUL = Char -> [Attribute] -> Glyph
Glyph '\x250C' []
glyphCornerLL :: Glyph
glyphCornerLL :: Glyph
glyphCornerLL = Char -> [Attribute] -> Glyph
Glyph '\x2514' []
glyphCornerUR :: Glyph
glyphCornerUR :: Glyph
glyphCornerUR = Char -> [Attribute] -> Glyph
Glyph '\x2510' []
glyphCornerLR :: Glyph
glyphCornerLR :: Glyph
glyphCornerLR = Char -> [Attribute] -> Glyph
Glyph '\x2518' []
glyphTeeL :: Glyph
glyphTeeL :: Glyph
glyphTeeL = Char -> [Attribute] -> Glyph
Glyph '\x251C' []
glyphTeeR :: Glyph
glyphTeeR :: Glyph
glyphTeeR = Char -> [Attribute] -> Glyph
Glyph '\x2524' []
glyphTeeB :: Glyph
glyphTeeB :: Glyph
glyphTeeB = Char -> [Attribute] -> Glyph
Glyph '\x2534' []
glyphTeeT :: Glyph
glyphTeeT :: Glyph
glyphTeeT = Char -> [Attribute] -> Glyph
Glyph '\x252C' []
glyphLineH :: Glyph
glyphLineH :: Glyph
glyphLineH = Char -> [Attribute] -> Glyph
Glyph '\x2500' []
glyphLineV :: Glyph
glyphLineV :: Glyph
glyphLineV = Char -> [Attribute] -> Glyph
Glyph '\x2502' []
glyphPlus :: Glyph
glyphPlus :: Glyph
glyphPlus = Char -> [Attribute] -> Glyph
Glyph '\x253C' []
glyphScan1 :: Glyph
glyphScan1 :: Glyph
glyphScan1 = Char -> [Attribute] -> Glyph
Glyph '\x23BA' []
glyphScan9 :: Glyph
glyphScan9 :: Glyph
glyphScan9 = Char -> [Attribute] -> Glyph
Glyph '\x23BD' []
glyphDiamond :: Glyph
glyphDiamond :: Glyph
glyphDiamond = Char -> [Attribute] -> Glyph
Glyph '\x25C6' []
glyphStipple :: Glyph
glyphStipple :: Glyph
glyphStipple = Char -> [Attribute] -> Glyph
Glyph '\x2592' []
glyphDegree :: Glyph
glyphDegree :: Glyph
glyphDegree = Char -> [Attribute] -> Glyph
Glyph '\xb0' []
glyphPlusMinus :: Glyph
glyphPlusMinus :: Glyph
glyphPlusMinus = Char -> [Attribute] -> Glyph
Glyph '\xb1' []
glyphBullet :: Glyph
glyphBullet :: Glyph
glyphBullet = Char -> [Attribute] -> Glyph
Glyph '\xb7' []
glyphArrowL :: Glyph
glyphArrowL :: Glyph
glyphArrowL = Char -> [Attribute] -> Glyph
Glyph '\x2190' []
glyphArrowR :: Glyph
glyphArrowR :: Glyph
glyphArrowR = Char -> [Attribute] -> Glyph
Glyph '\x2192' []
glyphArrowD :: Glyph
glyphArrowD :: Glyph
glyphArrowD = Char -> [Attribute] -> Glyph
Glyph '\x2193' []
glyphArrowU :: Glyph
glyphArrowU :: Glyph
glyphArrowU = Char -> [Attribute] -> Glyph
Glyph '\x2191' []
glyphBoard :: Glyph
glyphBoard :: Glyph
glyphBoard = Char -> [Attribute] -> Glyph
Glyph '\x2592' []
glyphLantern :: Glyph
glyphLantern :: Glyph
glyphLantern = Char -> [Attribute] -> Glyph
Glyph '\x2603' []
glyphBlock :: Glyph
glyphBlock :: Glyph
glyphBlock = Char -> [Attribute] -> Glyph
Glyph '\x25AE' []
glyphS3 :: Glyph
glyphS3 :: Glyph
glyphS3 = Char -> [Attribute] -> Glyph
Glyph '\x23BB' []
glyphS7 :: Glyph
glyphS7 :: Glyph
glyphS7 = Char -> [Attribute] -> Glyph
Glyph '\x23BC' []
glyphNE :: Glyph
glyphNE :: Glyph
glyphNE = Char -> [Attribute] -> Glyph
Glyph '\x2260' []
glyphLTE :: Glyph
glyphLTE :: Glyph
glyphLTE = Char -> [Attribute] -> Glyph
Glyph '\x2264' []
glyphGTE :: Glyph
glyphGTE :: Glyph
glyphGTE = Char -> [Attribute] -> Glyph
Glyph '\x2265' []
glyphPi :: Glyph
glyphPi :: Glyph
glyphPi = Char -> [Attribute] -> Glyph
Glyph '\x3c0' []
glyphSterling :: Glyph
glyphSterling :: Glyph
glyphSterling = Char -> [Attribute] -> Glyph
Glyph '\xa3' []
data Event
= EventCharacter Char
| EventSpecialKey Key
| EventMouse Integer MouseState
| EventResized
| EventUnknown Integer
deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq)
getEvent :: Window
-> Maybe Integer
-> Curses (Maybe Event)
getEvent :: Window -> Maybe Integer -> Curses (Maybe Event)
getEvent win :: Window
win timeout :: Maybe Integer
timeout = IO (Maybe Event) -> Curses (Maybe Event)
forall a. IO a -> Curses a
Curses IO (Maybe Event)
io where
io :: IO (Maybe Event)
io = (Ptr CUInt -> IO (Maybe Event)) -> IO (Maybe Event)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO (Maybe Event)) -> IO (Maybe Event))
-> (Ptr CUInt -> IO (Maybe Event)) -> IO (Maybe Event)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr CUInt
ptr -> do
Window -> CInt -> IO ()
wtimeout Window
win (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe Integer
timeout of
Nothing -> -1
Just n :: Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 -> 0
Just n :: Integer
n -> Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
n
CInt
rc <- Window -> Ptr CUInt -> IO CInt
hsncurses_wget_wch Window
win Ptr CUInt
ptr
if CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
rc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== EnumWrapper -> Integer
forall a. Enum a => a -> Integer
E.fromEnum EnumWrapper
E.ERR
then Maybe Event -> IO (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
forall a. Maybe a
Nothing
else (Event -> Maybe Event) -> IO Event -> IO (Maybe Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event -> Maybe Event
forall a. a -> Maybe a
Just (Ptr CUInt -> CInt -> IO Event
forall a a.
(Integral a, Storable a, Num a, Eq a) =>
Ptr a -> a -> IO Event
parseCode Ptr CUInt
ptr CInt
rc)
parseCode :: Ptr a -> a -> IO Event
parseCode ptr :: Ptr a
ptr rc :: a
rc = do
Integer
code <- a -> Integer
forall a. Integral a => a -> Integer
toInteger (a -> Integer) -> IO a -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
if a
rc a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Event
charEvent Integer
code)
else if Integer
code Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Key -> Integer
forall a. Enum a => a -> Integer
E.fromEnum Key
E.KEY_MOUSE
then IO Event
mouseEvent
else if Integer
code Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Key -> Integer
forall a. Enum a => a -> Integer
E.fromEnum Key
E.KEY_RESIZE
then Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
EventResized
else Integer -> IO Event
forall (m :: * -> *). Monad m => Integer -> m Event
keyEvent Integer
code
charEvent :: Integer -> Event
charEvent = Char -> Event
EventCharacter (Char -> Event) -> (Integer -> Char) -> Integer -> Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr (Int -> Char) -> (Integer -> Int) -> Integer -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger
mouseEvent :: IO Event
mouseEvent = Int -> (Ptr () -> IO Event) -> IO Event
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 20 ((Ptr () -> IO Event) -> IO Event)
-> (Ptr () -> IO Event) -> IO Event
forall a b. (a -> b) -> a -> b
$ \pEv :: Ptr ()
pEv -> do
Ptr () -> IO CInt
getmouse Ptr ()
pEv IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "getEvent"
Integer
evID <- (CShort -> Integer) -> IO CShort -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CShort -> Integer
forall a. Integral a => a -> Integer
toInteger ((\ptr :: Ptr ()
ptr -> do {Ptr () -> Int -> IO CShort
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr 0 :: IO C2HSImp.CShort}) Ptr ()
pEv)
Integer
x <- (CInt -> Integer) -> IO CInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Integer
forall a. Integral a => a -> Integer
toInteger ((\ptr :: Ptr ()
ptr -> do {Ptr () -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr 4 :: IO C2HSImp.CInt}) Ptr ()
pEv)
Integer
y <- (CInt -> Integer) -> IO CInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Integer
forall a. Integral a => a -> Integer
toInteger ((\ptr :: Ptr ()
ptr -> do {Ptr () -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr 8 :: IO C2HSImp.CInt}) Ptr ()
pEv)
Integer
z <- (CInt -> Integer) -> IO CInt -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Integer
forall a. Integral a => a -> Integer
toInteger ((\ptr :: Ptr ()
ptr -> do {Ptr () -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr 12 :: IO C2HSImp.CInt}) Ptr ()
pEv)
CUInt
mask <- (\ptr :: Ptr ()
ptr -> do {Ptr () -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr 16 :: IO C2HSImp.CUInt}) Ptr ()
pEv
let state :: MouseState
state = CUInt -> MouseState
parseMouseState CUInt
mask
Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> MouseState -> Event
EventMouse Integer
evID (MouseState
state { mouseCoordinates :: (Integer, Integer, Integer)
mouseCoordinates = (Integer
x, Integer
y, Integer
z) }))
codeF0 :: Integer
codeF0 = Key -> Integer
forall a. Enum a => a -> Integer
E.fromEnum Key
E.KEY_F0
codeF64 :: Integer
codeF64 = Integer
codeF0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 64
keyEvent :: Integer -> m Event
keyEvent code :: Integer
code = Event -> m Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> m Event) -> Event -> m Event
forall a b. (a -> b) -> a -> b
$ if Integer
code Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
codeF0 Bool -> Bool -> Bool
&& Integer
code Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
codeF64
then Key -> Event
EventSpecialKey (Integer -> Key
KeyFunction (Integer
code Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
codeF0))
else case Integer -> Map Integer Key -> Maybe Key
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Integer
code Map Integer Key
keyMap of
Just key :: Key
key -> Key -> Event
EventSpecialKey Key
key
Nothing -> Integer -> Event
EventUnknown Integer
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 (Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq)
keyMap :: M.Map Integer Key
keyMap :: Map Integer Key
keyMap = [(Integer, Key)] -> Map Integer Key
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Integer, Key)] -> Map Integer Key)
-> [(Integer, Key)] -> Map Integer Key
forall a b. (a -> b) -> a -> b
$ ((Key, Key) -> (Integer, Key)) -> [(Key, Key)] -> [(Integer, Key)]
forall a b. (a -> b) -> [a] -> [b]
map (\(enum :: Key
enum, key :: Key
key) -> (Key -> Integer
forall a. Enum a => a -> Integer
E.fromEnum Key
enum, Key
key))
[ (Key
E.KEY_DOWN, Key
KeyDownArrow)
, (Key
E.KEY_UP, Key
KeyUpArrow)
, (Key
E.KEY_LEFT, Key
KeyLeftArrow)
, (Key
E.KEY_RIGHT, Key
KeyRightArrow)
, (Key
E.KEY_HOME, Key
KeyHome)
, (Key
E.KEY_BACKSPACE, Key
KeyBackspace)
, (Key
E.KEY_DL, Key
KeyDeleteLine)
, (Key
E.KEY_IL, Key
KeyInsertLine)
, (Key
E.KEY_DC, Key
KeyDeleteCharacter)
, (Key
E.KEY_IC, Key
KeyInsertCharacter)
, (Key
E.KEY_EIC, Key
KeyEIC)
, (Key
E.KEY_CLEAR, Key
KeyClear)
, (Key
E.KEY_EOS, Key
KeyEOS)
, (Key
E.KEY_EOL, Key
KeyEOL)
, (Key
E.KEY_SF, Key
KeyScrollForward)
, (Key
E.KEY_SR, Key
KeyScrollBackward)
, (Key
E.KEY_NPAGE, Key
KeyNextPage)
, (Key
E.KEY_PPAGE, Key
KeyPreviousPage)
, (Key
E.KEY_STAB, Key
KeySetTab)
, (Key
E.KEY_CTAB, Key
KeyClearTab)
, (Key
E.KEY_CATAB, Key
KeyClearAllTabs)
, (Key
E.KEY_ENTER, Key
KeyEnter)
, (Key
E.KEY_PRINT, Key
KeyPrint)
, (Key
E.KEY_LL, Key
KeyHomeDown)
, (Key
E.KEY_A1, Key
KeyA1)
, (Key
E.KEY_A3, Key
KeyA3)
, (Key
E.KEY_B2, Key
KeyB2)
, (Key
E.KEY_C1, Key
KeyC1)
, (Key
E.KEY_C3, Key
KeyC3)
, (Key
E.KEY_BTAB, Key
KeyBackTab)
, (Key
E.KEY_BEG, Key
KeyBegin)
, (Key
E.KEY_CANCEL, Key
KeyCancel)
, (Key
E.KEY_CLOSE, Key
KeyClose)
, (Key
E.KEY_COMMAND, Key
KeyCommand)
, (Key
E.KEY_COPY, Key
KeyCopy)
, (Key
E.KEY_CREATE, Key
KeyCreate)
, (Key
E.KEY_END, Key
KeyEnd)
, (Key
E.KEY_EXIT, Key
KeyExit)
, (Key
E.KEY_FIND, Key
KeyFind)
, (Key
E.KEY_HELP, Key
KeyHelp)
, (Key
E.KEY_MARK, Key
KeyMark)
, (Key
E.KEY_MESSAGE, Key
KeyMessage)
, (Key
E.KEY_MOVE, Key
KeyMove)
, (Key
E.KEY_NEXT, Key
KeyNext)
, (Key
E.KEY_OPEN, Key
KeyOpen)
, (Key
E.KEY_OPTIONS, Key
KeyOptions)
, (Key
E.KEY_PREVIOUS, Key
KeyPrevious)
, (Key
E.KEY_REDO, Key
KeyRedo)
, (Key
E.KEY_REFERENCE, Key
KeyReference)
, (Key
E.KEY_REFRESH, Key
KeyRefresh)
, (Key
E.KEY_REPLACE, Key
KeyReplace)
, (Key
E.KEY_RESTART, Key
KeyRestart)
, (Key
E.KEY_RESUME, Key
KeyResume)
, (Key
E.KEY_SAVE, Key
KeySave)
, (Key
E.KEY_SBEG, Key
KeyShiftedBegin)
, (Key
E.KEY_SCANCEL, Key
KeyShiftedCancel)
, (Key
E.KEY_SCOMMAND, Key
KeyShiftedCommand)
, (Key
E.KEY_SCOPY, Key
KeyShiftedCopy)
, (Key
E.KEY_SCREATE, Key
KeyShiftedCreate)
, (Key
E.KEY_SDC, Key
KeyShiftedDeleteCharacter)
, (Key
E.KEY_SDL, Key
KeyShiftedDeleteLine)
, (Key
E.KEY_SELECT, Key
KeySelect)
, (Key
E.KEY_SEND, Key
KeyShiftedEnd)
, (Key
E.KEY_SEOL, Key
KeyShiftedEOL)
, (Key
E.KEY_SEXIT, Key
KeyShiftedExit)
, (Key
E.KEY_SFIND, Key
KeyShiftedFind)
, (Key
E.KEY_SHELP, Key
KeyShiftedHelp)
, (Key
E.KEY_SHOME, Key
KeyShiftedHome)
, (Key
E.KEY_SIC, Key
KeyShiftedInsertCharacter)
, (Key
E.KEY_SLEFT, Key
KeyShiftedLeftArrow)
, (Key
E.KEY_SMESSAGE, Key
KeyShiftedMessage)
, (Key
E.KEY_SMOVE, Key
KeyShiftedMove)
, (Key
E.KEY_SNEXT, Key
KeyShiftedNext)
, (Key
E.KEY_SOPTIONS, Key
KeyShiftedOptions)
, (Key
E.KEY_SPREVIOUS, Key
KeyShiftedPrevious)
, (Key
E.KEY_SPRINT, Key
KeyShiftedPrint)
, (Key
E.KEY_SREDO, Key
KeyShiftedRedo)
, (Key
E.KEY_SREPLACE, Key
KeyShiftedReplace)
, (Key
E.KEY_SRIGHT, Key
KeyShiftedRightArrow)
, (Key
E.KEY_SRSUME, Key
KeyShiftedResume)
, (Key
E.KEY_SSAVE, Key
KeyShiftedSave)
, (Key
E.KEY_SSUSPEND, Key
KeyShiftedSuspend)
, (Key
E.KEY_SUNDO, Key
KeyShiftedUndo)
, (Key
E.KEY_SUSPEND, Key
KeySuspend)
, (Key
E.KEY_UNDO, Key
KeyUndo)
]
data ButtonState
= ButtonPressed
| ButtonReleased
| ButtonClicked
| ButtonDoubleClicked
| ButtonTripleClicked
deriving (Int -> ButtonState -> ShowS
[ButtonState] -> ShowS
ButtonState -> String
(Int -> ButtonState -> ShowS)
-> (ButtonState -> String)
-> ([ButtonState] -> ShowS)
-> Show ButtonState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ButtonState] -> ShowS
$cshowList :: [ButtonState] -> ShowS
show :: ButtonState -> String
$cshow :: ButtonState -> String
showsPrec :: Int -> ButtonState -> ShowS
$cshowsPrec :: Int -> ButtonState -> ShowS
Show, ButtonState -> ButtonState -> Bool
(ButtonState -> ButtonState -> Bool)
-> (ButtonState -> ButtonState -> Bool) -> Eq ButtonState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ButtonState -> ButtonState -> Bool
$c/= :: ButtonState -> ButtonState -> Bool
== :: ButtonState -> ButtonState -> Bool
$c== :: ButtonState -> ButtonState -> Bool
Eq)
data MouseState = MouseState
{ MouseState -> (Integer, Integer, Integer)
mouseCoordinates :: (Integer, Integer, Integer)
, MouseState -> [(Integer, ButtonState)]
mouseButtons :: [(Integer, ButtonState)]
, MouseState -> Bool
mouseAlt :: Bool
, MouseState -> Bool
mouseShift :: Bool
, MouseState -> Bool
mouseControl :: Bool
}
deriving (Int -> MouseState -> ShowS
[MouseState] -> ShowS
MouseState -> String
(Int -> MouseState -> ShowS)
-> (MouseState -> String)
-> ([MouseState] -> ShowS)
-> Show MouseState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseState] -> ShowS
$cshowList :: [MouseState] -> ShowS
show :: MouseState -> String
$cshow :: MouseState -> String
showsPrec :: Int -> MouseState -> ShowS
$cshowsPrec :: Int -> MouseState -> ShowS
Show, MouseState -> MouseState -> Bool
(MouseState -> MouseState -> Bool)
-> (MouseState -> MouseState -> Bool) -> Eq MouseState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseState -> MouseState -> Bool
$c/= :: MouseState -> MouseState -> Bool
== :: MouseState -> MouseState -> Bool
$c== :: MouseState -> MouseState -> Bool
Eq)
parseMouseState :: MMaskT -> MouseState
parseMouseState :: CUInt -> MouseState
parseMouseState mask :: CUInt
mask = (Integer, Integer, Integer)
-> [(Integer, ButtonState)] -> Bool -> Bool -> Bool -> MouseState
MouseState (0, 0, 0) [(Integer, ButtonState)]
buttons Bool
alt Bool
shift Bool
ctrl where
maskI :: Integer
maskI = CUInt -> Integer
forall a. Integral a => a -> Integer
toInteger CUInt
mask
test :: a -> Bool
test e :: a
e = (Integer
maskI Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (a -> Integer
forall a. Enum a => a -> Integer
E.fromEnum a
e)) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0
alt :: Bool
alt = Button -> Bool
forall a. Enum a => a -> Bool
test Button
E.BUTTON_ALT
shift :: Bool
shift = Button -> Bool
forall a. Enum a => a -> Bool
test Button
E.BUTTON_SHIFT
ctrl :: Bool
ctrl = Button -> Bool
forall a. Enum a => a -> Bool
test Button
E.BUTTON_CTRL
buttons :: [(Integer, ButtonState)]
buttons = [Maybe (Integer, ButtonState)] -> [(Integer, ButtonState)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Integer, ButtonState)
button1, Maybe (Integer, ButtonState)
button2, Maybe (Integer, ButtonState)
button3, Maybe (Integer, ButtonState)
button4, Maybe (Integer, ButtonState)
button5]
testButton :: a -> a -> a -> a -> a -> a -> Maybe (a, ButtonState)
testButton idx :: a
idx r :: a
r p :: a
p c :: a
c dc :: a
dc tc :: a
tc
| a -> Bool
forall a. Enum a => a -> Bool
test a
r = (a, ButtonState) -> Maybe (a, ButtonState)
forall a. a -> Maybe a
Just (a
idx, ButtonState
ButtonReleased)
| a -> Bool
forall a. Enum a => a -> Bool
test a
p = (a, ButtonState) -> Maybe (a, ButtonState)
forall a. a -> Maybe a
Just (a
idx, ButtonState
ButtonPressed)
| a -> Bool
forall a. Enum a => a -> Bool
test a
c = (a, ButtonState) -> Maybe (a, ButtonState)
forall a. a -> Maybe a
Just (a
idx, ButtonState
ButtonClicked)
| a -> Bool
forall a. Enum a => a -> Bool
test a
dc = (a, ButtonState) -> Maybe (a, ButtonState)
forall a. a -> Maybe a
Just (a
idx, ButtonState
ButtonDoubleClicked)
| a -> Bool
forall a. Enum a => a -> Bool
test a
tc = (a, ButtonState) -> Maybe (a, ButtonState)
forall a. a -> Maybe a
Just (a
idx, ButtonState
ButtonTripleClicked)
| Bool
otherwise = Maybe (a, ButtonState)
forall a. Maybe a
Nothing
button1 :: Maybe (Integer, ButtonState)
button1 = Integer
-> Button
-> Button
-> Button
-> Button
-> Button
-> Maybe (Integer, ButtonState)
forall a a a a a a.
(Enum a, Enum a, Enum a, Enum a, Enum a) =>
a -> a -> a -> a -> a -> a -> Maybe (a, ButtonState)
testButton 1
Button
E.BUTTON1_RELEASED
Button
E.BUTTON1_PRESSED
Button
E.BUTTON1_CLICKED
Button
E.BUTTON1_DOUBLE_CLICKED
Button
E.BUTTON1_TRIPLE_CLICKED
button2 :: Maybe (Integer, ButtonState)
button2 = Integer
-> Button
-> Button
-> Button
-> Button
-> Button
-> Maybe (Integer, ButtonState)
forall a a a a a a.
(Enum a, Enum a, Enum a, Enum a, Enum a) =>
a -> a -> a -> a -> a -> a -> Maybe (a, ButtonState)
testButton 2
Button
E.BUTTON2_RELEASED
Button
E.BUTTON2_PRESSED
Button
E.BUTTON2_CLICKED
Button
E.BUTTON2_DOUBLE_CLICKED
Button
E.BUTTON2_TRIPLE_CLICKED
button3 :: Maybe (Integer, ButtonState)
button3 = Integer
-> Button
-> Button
-> Button
-> Button
-> Button
-> Maybe (Integer, ButtonState)
forall a a a a a a.
(Enum a, Enum a, Enum a, Enum a, Enum a) =>
a -> a -> a -> a -> a -> a -> Maybe (a, ButtonState)
testButton 3
Button
E.BUTTON3_RELEASED
Button
E.BUTTON3_PRESSED
Button
E.BUTTON3_CLICKED
Button
E.BUTTON3_DOUBLE_CLICKED
Button
E.BUTTON3_TRIPLE_CLICKED
button4 :: Maybe (Integer, ButtonState)
button4 = Integer
-> Button
-> Button
-> Button
-> Button
-> Button
-> Maybe (Integer, ButtonState)
forall a a a a a a.
(Enum a, Enum a, Enum a, Enum a, Enum a) =>
a -> a -> a -> a -> a -> a -> Maybe (a, ButtonState)
testButton 4
Button
E.BUTTON4_RELEASED
Button
E.BUTTON4_PRESSED
Button
E.BUTTON4_CLICKED
Button
E.BUTTON4_DOUBLE_CLICKED
Button
E.BUTTON4_TRIPLE_CLICKED
button5 :: Maybe (Integer, ButtonState)
button5 = Integer
-> Button
-> Button
-> Button
-> Button
-> Button
-> Maybe (Integer, ButtonState)
forall a a a a a a.
(Enum a, Enum a, Enum a, Enum a, Enum a) =>
a -> a -> a -> a -> a -> a -> Maybe (a, ButtonState)
testButton 5
Button
E.BUTTON5_RELEASED
Button
E.BUTTON5_PRESSED
Button
E.BUTTON5_CLICKED
Button
E.BUTTON5_DOUBLE_CLICKED
Button
E.BUTTON5_TRIPLE_CLICKED
data CursorMode
= CursorInvisible
| CursorVisible
| CursorVeryVisible
| CursorModeUnknown CInt
deriving (CursorMode -> CursorMode -> Bool
(CursorMode -> CursorMode -> Bool)
-> (CursorMode -> CursorMode -> Bool) -> Eq CursorMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CursorMode -> CursorMode -> Bool
$c/= :: CursorMode -> CursorMode -> Bool
== :: CursorMode -> CursorMode -> Bool
$c== :: CursorMode -> CursorMode -> Bool
Eq, Int -> CursorMode -> ShowS
[CursorMode] -> ShowS
CursorMode -> String
(Int -> CursorMode -> ShowS)
-> (CursorMode -> String)
-> ([CursorMode] -> ShowS)
-> Show CursorMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CursorMode] -> ShowS
$cshowList :: [CursorMode] -> ShowS
show :: CursorMode -> String
$cshow :: CursorMode -> String
showsPrec :: Int -> CursorMode -> ShowS
$cshowsPrec :: Int -> CursorMode -> ShowS
Show)
setCursorMode :: CursorMode -> Curses CursorMode
setCursorMode :: CursorMode -> Curses CursorMode
setCursorMode mode :: CursorMode
mode = IO CursorMode -> Curses CursorMode
forall a. IO a -> Curses a
Curses (IO CursorMode -> Curses CursorMode)
-> IO CursorMode -> Curses CursorMode
forall a b. (a -> b) -> a -> b
$ do
let intMode :: CInt
intMode = case CursorMode
mode of
CursorInvisible -> 0
CursorVisible -> 1
CursorVeryVisible -> 2
CursorModeUnknown n :: CInt
n -> CInt
n
CInt
rc <- CInt -> IO CInt
curs_set CInt
intMode
String -> CInt -> IO ()
checkRC "setCursorMode" CInt
rc
CursorMode -> IO CursorMode
forall (m :: * -> *) a. Monad m => a -> m a
return (CursorMode -> IO CursorMode) -> CursorMode -> IO CursorMode
forall a b. (a -> b) -> a -> b
$ case CInt
rc of
0 -> CursorMode
CursorInvisible
1 -> CursorMode
CursorVisible
2 -> CursorMode
CursorVeryVisible
_ -> CInt -> CursorMode
CursorModeUnknown CInt
rc
tryCurses :: Curses a -> Curses (Either CursesException a)
tryCurses :: Curses a -> Curses (Either CursesException a)
tryCurses (Curses io :: IO a
io) = IO (Either CursesException a) -> Curses (Either CursesException a)
forall a. IO a -> Curses a
Curses (IO a -> IO (Either CursesException a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
io)
catchCurses :: Curses a -> (CursesException -> Curses a) -> Curses a
catchCurses :: Curses a -> (CursesException -> Curses a) -> Curses a
catchCurses (Curses io :: IO a
io) fn :: CursesException -> Curses a
fn = IO a -> Curses a
forall a. IO a -> Curses a
Curses (IO a -> (CursesException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
io (Curses a -> IO a
forall a. Curses a -> IO a
unCurses (Curses a -> IO a)
-> (CursesException -> Curses a) -> CursesException -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CursesException -> Curses a
fn))
throwCurses :: CursesException -> Curses a
throwCurses :: CursesException -> Curses a
throwCurses = IO a -> Curses a
forall a. IO a -> Curses a
Curses (IO a -> Curses a)
-> (CursesException -> IO a) -> CursesException -> Curses a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CursesException -> IO a
forall e a. Exception e => e -> IO a
throwIO
setRaw :: Bool -> Curses ()
setRaw :: Bool -> Curses ()
setRaw set :: Bool
set = IO () -> Curses ()
forall a. IO a -> Curses a
Curses (IO CInt
io IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "setRaw") where
io :: IO CInt
io = if Bool
set then IO CInt
raw else IO CInt
noraw
{-# LINE 1214 "lib/UI/NCurses.chs" #-}
setCBreak :: Bool -> Curses ()
setCBreak :: Bool -> Curses ()
setCBreak set :: Bool
set = IO () -> Curses ()
forall a. IO a -> Curses a
Curses (IO CInt
io IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "setCBreak") where
io :: IO CInt
io = if Bool
set then IO CInt
cbreak else IO CInt
nocbreak
{-# LINE 1219 "lib/UI/NCurses.chs" #-}
setEcho :: Bool -> Curses ()
setEcho :: Bool -> Curses ()
setEcho set :: Bool
set = IO () -> Curses ()
forall a. IO a -> Curses a
Curses (IO CInt
io IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "setEcho") where
io :: IO CInt
io = if Bool
set then IO CInt
echo else IO CInt
noecho
{-# LINE 1224 "lib/UI/NCurses.chs" #-}
baudrate :: Curses Integer
baudrate :: Curses Integer
baudrate = IO Integer -> Curses Integer
forall a. IO a -> Curses a
Curses (IO Integer -> Curses Integer) -> IO Integer -> Curses Integer
forall a b. (a -> b) -> a -> b
$ do
CInt
rc <- IO CInt
c_baudrate
{-# LINE 1229 "lib/UI/NCurses.chs" #-}
checkRC "baudrate" rc
return (toInteger rc)
beep :: Curses ()
beep :: Curses ()
beep = IO () -> Curses ()
forall a. IO a -> Curses a
Curses (IO CInt
c_beep IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "beep")
flash :: Curses ()
flash :: Curses ()
flash = IO () -> Curses ()
forall a. IO a -> Curses a
Curses (IO CInt
c_flash IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "flash")
hasMouse :: Curses Bool
hasMouse :: Curses Bool
hasMouse = IO Bool -> Curses Bool
forall a. IO a -> Curses a
Curses ((CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Bool
forall a. Integral a => a -> Bool
cToBool IO CInt
c_hasMouse)
foreign import ccall unsafe "hsncurses_has_mouse"
c_hasMouse :: IO CInt
enclosed :: Window
-> Integer
-> Integer
-> Curses Bool
enclosed :: Window -> Integer -> Integer -> Curses Bool
enclosed win :: Window
win row :: Integer
row col :: Integer
col = IO Bool -> Curses Bool
forall a. IO a -> Curses a
Curses (IO Bool -> Curses Bool)
-> (IO CUChar -> IO Bool) -> IO CUChar -> Curses Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CUChar -> Bool) -> IO CUChar -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUChar -> Bool
forall a. Integral a => a -> Bool
cToBool (IO CUChar -> Curses Bool) -> IO CUChar -> Curses Bool
forall a b. (a -> b) -> a -> b
$
Window -> CInt -> CInt -> IO CUChar
wenclose Window
win (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
row) (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
col)
screenSize :: Curses (Integer, Integer)
screenSize :: Curses (Integer, Integer)
screenSize = IO (Integer, Integer) -> Curses (Integer, Integer)
forall a. IO a -> Curses a
Curses (IO (Integer, Integer) -> Curses (Integer, Integer))
-> IO (Integer, Integer) -> Curses (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ do
CInt
rows <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
c_LINES
CInt
cols <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
c_COLS
(Integer, Integer) -> IO (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
rows, CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
cols)
foreign import ccall "static &LINES"
c_LINES :: Ptr CInt
foreign import ccall "static &COLS"
c_COLS :: Ptr CInt
setTouched :: Bool -> Update ()
setTouched :: Bool -> Update ()
setTouched touched :: Bool
touched = String -> (Window -> IO CInt) -> Update ()
withWindow_ "setTouched" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ if Bool
touched
then Window -> IO CInt
touchwin
{-# LINE 1271 "lib/UI/NCurses.chs" #-}
else untouchwin
{-# LINE 1272 "lib/UI/NCurses.chs" #-}
setRowsTouched :: Bool
-> Integer
-> Integer
-> Update ()
setRowsTouched :: Bool -> Integer -> Integer -> Update ()
setRowsTouched touched :: Bool
touched start :: Integer
start count :: Integer
count = String -> (Window -> IO CInt) -> Update ()
withWindow_ "setRowsTouched" ((Window -> IO CInt) -> Update ())
-> (Window -> IO CInt) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win ->
Window -> CInt -> CInt -> CInt -> IO CInt
wtouchln Window
win
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
start)
(Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
count)
(Bool -> CInt
forall a. Integral a => Bool -> a
cFromBool Bool
touched)
setKeypad :: Window -> Bool -> Curses ()
setKeypad :: Window -> Bool -> Curses ()
setKeypad win :: Window
win set :: Bool
set = IO () -> Curses ()
forall a. IO a -> Curses a
Curses (IO CInt
io IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "setKeypad") where
io :: IO CInt
io = Window -> CUChar -> IO CInt
keypad Window
win (Bool -> CUChar
forall a. Integral a => Bool -> a
cFromBool Bool
set)
resizeTerminal :: Integer -> Integer -> Curses ()
resizeTerminal :: Integer -> Integer -> Curses ()
resizeTerminal lines :: Integer
lines cols :: Integer
cols = IO () -> Curses ()
forall a. IO a -> Curses a
Curses (IO CInt
io IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC "resizeTerminal") where
io :: IO CInt
io = CInt -> CInt -> IO CInt
resizeterm (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
lines) (Integer -> CInt
forall a. Num a => Integer -> a
fromInteger Integer
cols)
withWindow :: (Window -> IO a) -> Update a
withWindow :: (Window -> IO a) -> Update a
withWindow io :: Window -> IO a
io = ReaderT Window Curses a -> Update a
forall a. ReaderT Window Curses a -> Update a
Update ((Window -> Curses a) -> ReaderT Window Curses a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
R.ReaderT (\win :: Window
win -> IO a -> Curses a
forall a. IO a -> Curses a
Curses (Window -> IO a
io Window
win)))
withWindow_ :: String -> (Window -> IO CInt) -> Update ()
withWindow_ :: String -> (Window -> IO CInt) -> Update ()
withWindow_ name :: String
name io :: Window -> IO CInt
io = (Window -> IO ()) -> Update ()
forall a. (Window -> IO a) -> Update a
withWindow ((Window -> IO ()) -> Update ()) -> (Window -> IO ()) -> Update ()
forall a b. (a -> b) -> a -> b
$ \win :: Window
win -> Window -> IO CInt
io Window
win IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
checkRC String
name
foreign import ccall safe "UI/NCurses.chs.h endwin"
endwin :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h initscr"
initscr :: (IO (Window))
foreign import ccall safe "UI/NCurses.chs.h cbreak"
cbreak :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h mousemask"
mousemask :: (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (IO C2HSImp.CUInt)))
foreign import ccall safe "UI/NCurses.chs.h has_colors"
has_colors :: (IO C2HSImp.CUChar)
foreign import ccall safe "UI/NCurses.chs.h start_color"
start_color :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h use_default_colors"
use_default_colors :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h keypad"
keypad :: ((Window) -> (C2HSImp.CUChar -> (IO C2HSImp.CInt)))
foreign import ccall safe "UI/NCurses.chs.h meta"
meta :: ((Window) -> (C2HSImp.CUChar -> (IO C2HSImp.CInt)))
foreign import ccall safe "UI/NCurses.chs.h wtimeout"
wtimeout :: ((Window) -> (C2HSImp.CInt -> (IO ())))
foreign import ccall safe "UI/NCurses.chs.h newwin"
newwin :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO (Window))))))
foreign import ccall safe "UI/NCurses.chs.h delwin"
delwin :: ((Window) -> (IO C2HSImp.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 C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h mvwin"
mvwin :: ((Window) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "UI/NCurses.chs.h getbegy"
getbegy :: ((Window) -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h getbegx"
getbegx :: ((Window) -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h wresize"
wresize :: ((Window) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "UI/NCurses.chs.h getmaxy"
getmaxy :: ((Window) -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h getmaxx"
getmaxx :: ((Window) -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h overlay"
c_overlay :: ((Window) -> ((Window) -> (IO C2HSImp.CInt)))
foreign import ccall safe "UI/NCurses.chs.h overwrite"
overwrite :: ((Window) -> ((Window) -> (IO C2HSImp.CInt)))
foreign import ccall safe "UI/NCurses.chs.h copywin"
copywin :: ((Window) -> ((Window) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))))))
foreign import ccall safe "UI/NCurses.chs.h newpad"
newpad :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO (Window))))
foreign import ccall safe "UI/NCurses.chs.h pnoutrefresh"
pnoutrefresh :: ((Window) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))))
foreign import ccall safe "UI/NCurses.chs.h wmove"
wmove :: ((Window) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "UI/NCurses.chs.h getcury"
getcury :: ((Window) -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h getcurx"
getcurx :: ((Window) -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h doupdate"
doupdate :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h wcolor_set"
wcolor_set :: ((Window) -> (C2HSImp.CShort -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))
foreign import ccall safe "UI/NCurses.chs.h waddwstr"
waddwstr :: ((Window) -> ((CWString) -> (IO C2HSImp.CInt)))
foreign import ccall safe "UI/NCurses.chs.h wadd_wch"
wadd_wch :: ((Window) -> ((CCharT) -> (IO C2HSImp.CInt)))
foreign import ccall safe "UI/NCurses.chs.h wborder_set"
wborder_set :: ((Window) -> ((CCharT) -> ((CCharT) -> ((CCharT) -> ((CCharT) -> ((CCharT) -> ((CCharT) -> ((CCharT) -> ((CCharT) -> (IO C2HSImp.CInt))))))))))
foreign import ccall safe "UI/NCurses.chs.h whline_set"
whline_set :: ((Window) -> ((CCharT) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "UI/NCurses.chs.h wvline_set"
wvline_set :: ((Window) -> ((CCharT) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "UI/NCurses.chs.h wclear"
wclear :: ((Window) -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h wclrtoeol"
wclrtoeol :: ((Window) -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h wbkgrndset"
wbkgrndset :: ((Window) -> ((CCharT) -> (IO ())))
foreign import ccall unsafe "UI/NCurses.chs.h COLOR_PAIR"
c_COLOR_PAIR :: (C2HSImp.CInt -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h wattr_on"
wattr_on :: ((Window) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))
foreign import ccall safe "UI/NCurses.chs.h wattr_off"
wattr_off :: ((Window) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))
foreign import ccall safe "UI/NCurses.chs.h wattr_get"
wattr_get :: ((Window) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CShort) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))
foreign import ccall safe "UI/NCurses.chs.h wattr_set"
wattr_set :: ((Window) -> (C2HSImp.CUInt -> (C2HSImp.CShort -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))
foreign import ccall safe "UI/NCurses.chs.h can_change_color"
can_change_color :: (IO C2HSImp.CUChar)
foreign import ccall safe "UI/NCurses.chs.h init_color"
init_color :: (C2HSImp.CShort -> (C2HSImp.CShort -> (C2HSImp.CShort -> (C2HSImp.CShort -> (IO C2HSImp.CInt)))))
foreign import ccall safe "UI/NCurses.chs.h color_content"
color_content :: (C2HSImp.CShort -> ((C2HSImp.Ptr C2HSImp.CShort) -> ((C2HSImp.Ptr C2HSImp.CShort) -> ((C2HSImp.Ptr C2HSImp.CShort) -> (IO C2HSImp.CInt)))))
foreign import ccall safe "UI/NCurses.chs.h init_pair"
init_pair :: (C2HSImp.CShort -> (C2HSImp.CShort -> (C2HSImp.CShort -> (IO C2HSImp.CInt))))
foreign import ccall safe "UI/NCurses.chs.h hsncurses_init_cchar_t"
hsncurses_init_cchar_t :: ((CCharT) -> (C2HSImp.CUInt -> ((CWString) -> (C2HSImp.CULong -> (IO ())))))
foreign import ccall safe "UI/NCurses.chs.h hsncurses_wget_wch"
hsncurses_wget_wch :: ((Window) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (IO C2HSImp.CInt)))
foreign import ccall safe "UI/NCurses.chs.h getmouse"
getmouse :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h curs_set"
curs_set :: (C2HSImp.CInt -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h raw"
raw :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h noraw"
noraw :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h nocbreak"
nocbreak :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h echo"
echo :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h noecho"
noecho :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h baudrate"
c_baudrate :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h beep"
c_beep :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h flash"
c_flash :: (IO C2HSImp.CInt)
foreign import ccall safe "UI/NCurses.chs.h wenclose"
wenclose :: ((Window) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CUChar))))
foreign import ccall safe "UI/NCurses.chs.h touchwin"
touchwin :: ((Window) -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h untouchwin"
untouchwin :: ((Window) -> (IO C2HSImp.CInt))
foreign import ccall safe "UI/NCurses.chs.h wtouchln"
wtouchln :: ((Window) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))
foreign import ccall safe "UI/NCurses.chs.h resizeterm"
resizeterm :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))