packages feed

ncurses 0.2.11 → 0.2.12

raw patch · 5 files changed

+209/−80 lines, 5 files

Files

cbits/hsncurses-shim.c view
@@ -37,3 +37,12 @@ 	pthread_sigmask(SIG_SETMASK, &old_mask, NULL); 	return rc; }++void hsncurses_init_cchar_t(cchar_t *wch, attr_t attr, wchar_t *chars, size_t chars_len) {+	size_t ii;+	memset(wch, 0, sizeof(cchar_t));+	wch->attr = attr;+	for (ii = 0; ii < chars_len && ii < CCHARW_MAX; ii++) {+		wch->chars[ii] = chars[ii];+	}+}
cbits/hsncurses-shim.h view
@@ -17,4 +17,6 @@  int hsncurses_wget_wch(WINDOW *, wint_t *); +void hsncurses_init_cchar_t(cchar_t *wch, attr_t attr, wchar_t *chars, size_t chars_len);+ #endif
lib/UI/NCurses.chs view
@@ -30,18 +30,35 @@ 	, newWindow 	, closeWindow 	, cloneWindow+	, moveWindow+	, windowPosition+	, resizeWindow+	, windowSize+	, updateWindow 	+	-- ** Virtual windows (pads)+	, Pad+	, newPad+	, closePad+	, updatePad+	+	-- * The cursor+	, moveCursor+	, cursorPosition+	, getCursor+	 	-- * Drawing to the screen-	, updateWindow 	, render-	, moveCursor 	, setColor 	, drawString 	, drawText+	, drawGlyph 	, drawBorder 	, drawBox 	, drawLineH 	, drawLineV+	, clear+	, clearLine 	, setBackground 	 	-- * Attributes@@ -130,7 +147,7 @@ 	, setTouched 	, setRowsTouched 	, setKeypad-	, getCursor+	, resizeTerminal 	) where  import           Control.Exception (bracket_)@@ -166,23 +183,6 @@  #include "cbits/hsncurses-shim.h" --- Starting with version 0.18.1, c2hs changed the handling of get/set hooks--- when using newtype'd pointers: <https://github.com/haskell/c2hs/issues/96>.------ Version 0.18.2 introduced the C2HS_MIN_VERSION macro to perform--- version detection: <https://github.com/haskell/c2hs/issues/107>.------ Detecting version 0.18.1 is impractical, so we depend on a Cabal flag for--- users who need that particular version.-#if !defined(HSNCURSES_NEWTYPE_POINTER_HOOKS)-#if !defined(C2HS_MIN_VERSION)-#define C2HS_MIN_VERSION(mj,mn,rv) (mj<=0&&mn<=18&&rv<=0)-#endif-#if C2HS_MIN_VERSION(0,18,1)-#define HSNCURSES_NEWTYPE_POINTER_HOOKS-#endif-#endif- {# pointer *WINDOW as Window nocode #} {# pointer *cchar_t as CCharT newtype #} {# pointer *wchar_t as CWString nocode #}@@ -270,6 +270,106 @@ 	Curses ({# call wnoutrefresh #} win >>= checkRC "updateWindow") 	return a +-- | Moves the window to the given (row,column) coordinate.+moveWindow :: Integer -> Integer -> Update ()+moveWindow row col = withWindow_ "moveWindow"  $ \win ->+	{# call mvwin #} win (fromInteger row) (fromInteger col)++-- | Returns the current (row, column) coordinates of the window.+windowPosition :: Update (Integer, Integer)+windowPosition = withWindow $ \win -> do+	row <- {# call getbegx #} win+	col <- {# call getbegy #} win+	return (toInteger row, toInteger col)++-- | Resizes the window to the given row and column dimensions.+resizeWindow :: Integer -> Integer -> Update ()+resizeWindow rows cols = withWindow_ "resizeWindow"  $ \win ->+	{# call wresize #} win (fromInteger rows) (fromInteger cols)++-- Returns the current (row, column) dimensions of the window.+windowSize :: Update (Integer, Integer)+windowSize = withWindow $ \win -> do+	rows <- {# call getmaxx #} win+	cols <- {# call getmaxy #} win+	return (toInteger rows, toInteger cols)++-- | A Pad is a 'Window' that is not associated with the screen.+newtype Pad = Pad Window++-- | Create a new 'Pad' with the given dimensions.+--+-- When the pad is no longer needed, call 'closePad'. Pads are not+-- garbage&#x2013;collected, because there&#x2019;s no way to know if+-- they&#x2019;re still in use.+newPad :: Integer -- ^ Rows+       -> Integer -- ^ Columns+       -> Curses Pad+newPad rows cols = Curses $ do+	win <- {# call newpad #}+		(fromInteger rows)+		(fromInteger cols)+	if windowPtr win == nullPtr+		then error "newPad: newpad() returned NULL"+		else do+			void $ {# call keypad #} win 1+			void $ {# call meta #} win 1+			{# call wtimeout #} win (- 1)+			return (Pad win)++-- | Close a pad, and free all resources associated with it. Once a+-- pad has been closed, it is no longer safe to use.+closePad :: Pad -> Curses ()+closePad (Pad win) = Curses ({# call delwin #} win >>= checkRC "closePad")++updatePad :: Pad+          -> Integer -- Top-most row of the pad's update region (pminrow).+          -> Integer -- Left-most column of the pad's update region (pmincol).+          -> Integer -- Top-most row of the screen's update region (sminrow).+          -> Integer -- Left-most column of the screen's update region (smincol).+          -> Integer -- Bottom-most row of the screen's update region (smaxrow).+          -> Integer -- Right-most column of the screen's update region (smaxcol).+          -> Update a+          -> Curses a+updatePad (Pad win) pminrow pmincol sminrow smincol smaxrow smaxcol (Update reader) = do+	a <- R.runReaderT reader win+	Curses $+		({# call pnoutrefresh #} win+			(fromInteger pminrow)+			(fromInteger pmincol)+			(fromInteger sminrow)+			(fromInteger smincol)+			(fromInteger smaxrow)+			(fromInteger smaxcol))+		>>= checkRC "updatePad"+	return a++-- | Move the window&#x2019;s cursor position to the given row and column.+moveCursor :: Integer -- ^ Row+           -> Integer -- ^ Column+           -> Update ()+moveCursor y x = withWindow_ "moveCursor" $ \win ->+	{# call wmove #} win (fromInteger y) (fromInteger x)++-- | Returns the current (row,column) coordinates of the cursor.+--+-- This is the same as 'getCursor', but is usable within an Update.+cursorPosition :: Update (Integer, Integer)+cursorPosition = withWindow $ \win -> do+	row <- {# call getcurx #} win+	col <- {# call getcury #} win+	return (toInteger row, toInteger col)++-- | Return current cursor position as (row, column).+--+-- This is the same as 'cursorPosition', but is usable outside+-- of an Update.+getCursor :: Window -> Curses (Integer, Integer)+getCursor win = Curses $ do+	row <- {# call getcury #} win+	col <- {# call getcurx #} win+	return (toInteger row, toInteger col)+ -- | Re&#x2013;draw any portions of the screen which have changed since the -- last render. render :: Curses ()@@ -281,13 +381,6 @@ setColor (ColorID pair) = withWindow_ "setColor" $ \win -> 	{# call wcolor_set #} win pair nullPtr --- | Move the window&#x2019;s cursor position to the given row and column.-moveCursor :: Integer -- ^ Row-           -> Integer -- ^ Column-           -> Update ()-moveCursor y x = withWindow_ "moveCursor" $ \win ->-	{# call wmove #} win (fromInteger y) (fromInteger x)- -- | Add some text to the window, at the current cursor position. drawString :: String -> Update () drawString str = withWindow_ "drawString" $ \win ->@@ -298,6 +391,11 @@ drawText txt = withWindow_ "drawText" $ \win -> 	withCWString (T.unpack txt) ({# call waddwstr #} win) +drawGlyph :: Glyph -> Update ()+drawGlyph glyph = withWindow_ "drawGlyph" $ \win ->+	withGlyph glyph $ \pGlyph ->+	{# call wadd_wch #} win pGlyph+ -- | Draw a border around the edge of the window. For any edge, passing -- 'Nothing' means to use the default glyph. drawBorder :: Maybe Glyph -- ^ Left edge@@ -311,14 +409,14 @@            -> 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 ->+	withMaybeGlyph le $ \pLE ->+	withMaybeGlyph re $ \pRE ->+	withMaybeGlyph te $ \pTE ->+	withMaybeGlyph be $ \pBE ->+	withMaybeGlyph tl $ \pTL ->+	withMaybeGlyph tr $ \pTR ->+	withMaybeGlyph bl $ \pBL ->+	withMaybeGlyph br $ \pBR -> 	{# call wborder_set #} win pLE pRE pTE pBE pTL pTR pBL pBR  -- | @drawBox v h = drawBorder v v h h Nothing Nothing Nothing Nothing@@@ -329,34 +427,50 @@ -- maximum character count. The cursor position is not changed. drawLineH :: Maybe Glyph -> Integer -> Update () drawLineH g n = withWindow_ "drawLineH" $ \win ->-	withGlyph g $ \pChar ->+	withMaybeGlyph g $ \pChar -> 	{# call whline_set #} win pChar (fromInteger n)  -- | Draw a vertical line from top to bottom, using the given glyph and -- maximum character count. The cursor position is not changed. drawLineV :: Maybe Glyph -> Integer -> Update () drawLineV g n = withWindow_ "drawLineV" $ \win ->-	withGlyph g $ \pChar ->+	withMaybeGlyph g $ \pChar -> 	{# call wvline_set #} win pChar (fromInteger n) +-- | Clear the window content by drawing blanks to every position.+clear :: Update ()+clear = withWindow_ "clear" {# call wclear #}++-- | Clear the current line starting from the current cursor position+-- (inclusive) to the end of the line.+clearLine :: Update ()+clearLine = withWindow_ "clear" {# call wclrtoeol #}+ -- | Set the window&#x2019;s background glyph. The glyph will be drawn in -- place of any blank characters, and the glyph&#x2019;s attributes will be -- combined with those of every character. setBackground :: Glyph -> Update () setBackground g = withWindow_ "setBackground" $ \win ->-	withGlyph (Just g) $ \pChar ->+	withMaybeGlyph (Just g) $ \pChar -> 	{# call wbkgrndset #} win pChar >> return 0  data Attribute-	= AttributeStandout-	| AttributeUnderline-	| AttributeReverse-	| AttributeBlink-	| AttributeDim-	| AttributeBold-	| AttributeAltCharset-	| AttributeInvisible-	| AttributeProtect+	= AttributeColor ColorID -- ^ A_COLOR+	| AttributeStandout -- ^ A_STANDOUT+	| AttributeUnderline -- ^ A_UNDERLINE+	| AttributeReverse -- ^ A_REVERSE+	| AttributeBlink -- ^ A_BLINK+	| AttributeDim -- ^ A_DIM+	| AttributeBold -- ^ A_BOLD+	| AttributeAltCharset -- ^ A_ALTCHARSET+	| AttributeInvisible -- ^ A_INVISIBLE+	| AttributeProtect -- ^ A_PROTECT+	| AttributeHorizontal -- ^ A_HORIZONTAL+	| AttributeLeft -- ^ A_LEFT+	| AttributeLow -- ^ A_LOW+	| AttributeRight -- ^ A_RIGHT+	| AttributeTop -- ^ A_TOP+	| AttributeVertical -- ^ A_VERTICAL 	deriving (Show, Eq)  attrEnum :: E.Attribute -> AttrT@@ -373,7 +487,17 @@ 	AttributeAltCharset  -> attrEnum E.WA_ALTCHARSET 	AttributeInvisible   -> attrEnum E.WA_INVIS 	AttributeProtect     -> attrEnum E.WA_PROTECT+	AttributeHorizontal  -> attrEnum E.WA_HORIZONTAL+	AttributeLeft        -> attrEnum E.WA_LEFT+	AttributeLow         -> attrEnum E.WA_LOW+	AttributeRight       -> attrEnum E.WA_RIGHT+	AttributeTop         -> attrEnum E.WA_TOP+	AttributeVertical    -> attrEnum E.WA_VERTICAL +	-- Colors get special handling: the function COLOR_PAIR converts an+	-- NCURSES_PAIRS_T to an attr_t.+	AttributeColor (ColorID cid) -> fromIntegral ({# call pure unsafe COLOR_PAIR as c_COLOR_PAIR #} (fromIntegral cid))+ -- | Set a single 'Attribute' on the current window. No other attributes -- are modified. setAttribute :: Attribute -> Bool -> Update ()@@ -515,20 +639,16 @@ 	} 	deriving (Show, Eq) -withGlyph :: Maybe Glyph -> (CCharT -> IO a) -> IO a-withGlyph Nothing io = io (CCharT nullPtr)-withGlyph (Just (Glyph char attrs)) io =+withMaybeGlyph :: Maybe Glyph -> (CCharT -> IO a) -> IO a+withMaybeGlyph Nothing io = io (CCharT nullPtr)+withMaybeGlyph (Just g) io = withGlyph g io++withGlyph :: Glyph -> (CCharT -> IO a) -> IO a+withGlyph (Glyph char attrs) io = 	let cAttrs = foldl' (\acc a -> acc .|. attrToInt a) 0 attrs in-	+	withCWStringLen [char] $ \(cChars, cCharsLen) -> 	allocaBytes {# sizeof cchar_t #} $ \pBuf -> do-	void $ {# call memset #} (castPtr pBuf) 0 {# sizeof cchar_t #}-#ifdef HSNCURSES_NEWTYPE_POINTER_HOOKS-	{# set cchar_t->attr #} (CCharT pBuf) cAttrs-	{# set cchar_t->chars #} (CCharT pBuf) (wordPtrToPtr (fromIntegral (ord char)))-#else-	{# set cchar_t->attr #} pBuf cAttrs-	{# set cchar_t->chars #} pBuf (wordPtrToPtr (fromIntegral (ord char)))-#endif+	{# call hsncurses_init_cchar_t #} (CCharT pBuf) cAttrs cChars (fromIntegral cCharsLen) 	io (CCharT pBuf)  -- | Upper left corner@@ -669,9 +789,13 @@  -- | Get the next 'Event' from a given window. ----- If the timeout is specified, and no event is received within the timeout,--- @getEvent@ returns 'Nothing'. If the timeout is 0 or less, @getEvent@--- will not block at all.+-- If the timeout is 'Nothing', @getEvent@ blocks until an event is received.+--+-- If the timeout is specified, @getEvent@ blocks for up to that many+-- milliseconds. If no event is received before timing out, @getEvent@ returns+-- 'Nothing'.+--+-- If the timeout is 0 or less, @getEvent@ will not block at all. getEvent :: Window          -> Maybe Integer -- ^ Timeout, in milliseconds          -> Curses (Maybe Event)@@ -1075,11 +1199,10 @@ setKeypad win set = Curses (io >>= checkRC "setKeypad") where 	io = {# call keypad #} win (cFromBool set) -getCursor :: Window -> Curses (Integer, Integer)-getCursor win = Curses $ do-	row <- {# call getcury #} win-	col <- {# call getcurx #} win-	return (toInteger row, toInteger col)+-- | Attempt to resize the terminal to the given number of lines and columns.+resizeTerminal :: Integer -> Integer -> Curses ()+resizeTerminal lines cols = Curses (io >>= checkRC "resizeTerminal") where+	io = {# call resizeterm #} (fromInteger lines) (fromInteger cols)  withWindow :: (Window -> IO a) -> Update a withWindow io = Update (R.ReaderT (\win -> Curses (io win)))
lib/UI/NCurses/Enums.chs view
@@ -75,6 +75,12 @@ , hsncurses_WA_ALTCHARSET = WA_ALTCHARSET , hsncurses_WA_INVIS = WA_INVIS , hsncurses_WA_PROTECT = WA_PROTECT+, hsncurses_WA_HORIZONTAL = WA_HORIZONTAL+, hsncurses_WA_LEFT = WA_LEFT+, hsncurses_WA_LOW = WA_LOW+, hsncurses_WA_RIGHT = WA_RIGHT+, hsncurses_WA_TOP = WA_TOP+, hsncurses_WA_VERTICAL = WA_VERTICAL }; #endc
ncurses.cabal view
@@ -1,5 +1,5 @@ name: ncurses-version: 0.2.11+version: 0.2.12 license: GPL-3 license-file: license.txt author: John Millikin <jmillikin@gmail.com>@@ -57,7 +57,7 @@ source-repository this   type: git   location: https://john-millikin.com/code/haskell-ncurses/-  tag: haskell-ncurses_0.2.11+  tag: haskell-ncurses_0.2.12  -- Do not use default to using pkg-config to find ncurses libraries, because -- the .pc files are missing or broken in many installations.@@ -75,14 +75,6 @@     only useful on systems that have the ncursesw package installed     incorrectly. On most systems this will cause compile- or run-time errors. -flag force-c2hs-newtype-pointer-hooks-  default: False-  manual: True-  description:-    Force using the newtype'd pointer hooks introduced in c2hs 0.18.1. This-    is only necessary when building with c2hs==0.18.1, as 0.18.2 and later-    can be auto-detected.- library   hs-source-dirs: lib   ghc-options: -Wall -O2@@ -115,9 +107,6 @@       extra-libraries: panel ncurses pthread     else       extra-libraries: panelw ncursesw pthread--  if flag(force-c2hs-newtype-pointer-hooks)-    cc-options: -DHSNCURSES_NEWTYPE_POINTER_HOOKS    c-sources: cbits/hsncurses-shim.c