Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

removed hscurses -- at the moment, there's no need for a curses frontend

  • Loading branch information...
commit 26bd845830ba8b2fba0e52c1847b7569e4f1f77b 1 parent 2bc8f16
@kosmikus kosmikus authored
View
638 Curses.hsc
@@ -1,638 +0,0 @@
---
--- Copyright (c) 2002-2004 John Meacham (john at repetae dot net)
--- Copyright (c) 2004-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons
---
--- Permission is hereby granted, free of charge, to any person obtaining a
--- copy of this software and associated documentation files (the
--- "Software"), to deal in the Software without restriction, including
--- without limitation the rights to use, copy, modify, merge, publish,
--- distribute, sublicense, and/or sell copies of the Software, and to
--- permit persons to whom the Software is furnished to do so, subject to
--- the following conditions:
---
--- The above copyright notice and this permission notice shall be included
--- in all copies or substantial portions of the Software.
---
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
--- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
--- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
--- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
--- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
--- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
--- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
---
-
---
--- | Binding to the [wn]curses library. From the ncurses man page:
---
--- > The curses library routines give the user a terminal-inde-
--- > pendent method of updating character screens with reason-
--- > able optimization.
---
--- Sections of the quoted documentation are from the OpenBSD man pages,
--- which are distributed under a BSD license.
---
--- A useful reference is:
--- /Writing Programs with NCURSES/, by Eric S. Raymond and Zeyd
--- M. Ben-Halim, <http://dickey.his.com/ncurses/>
---
--- attrs dont work with Irix curses.h. This should be fixed.
---
-
-#include "utils.h"
-
-module Curses (
-
- initCurses, -- :: IO () -> IO ()
- resetParams, -- :: IO ()
-
- stdScr, -- :: Window
- endWin, -- :: IO ()
-
- keypad, -- :: Window -> Bool -> IO ()
- scrSize, -- :: IO (Int, Int)
- refresh, -- :: IO ()
- getCh, -- :: IO Char
-
- -- * Line drawing
- waddnstr, -- :: Window -> CString -> CInt -> IO CInt
- bkgrndSet, -- :: Attr -> Pair -> IO ()
- clrToEol, -- :: IO ()
- wMove, -- :: Window -> Int -> Int -> IO ()
-
- -- * Key codes
- keyBackspace, keyUp, keyDown, keyNPage, keyHome, keyPPage, keyEnd,
- keyLeft, keyRight,
-#ifdef KEY_RESIZE
- keyResize,
-#endif
-
- -- * Cursor
- CursorVisibility(..),
- cursSet, -- :: CInt -> IO CInt
- getYX, -- :: Window -> IO (Int, Int)
-
- -- * Colours
- Pair(..), Color,
- initPair, -- :: Pair -> Color -> Color -> IO ()
- color, -- :: String -> Maybe Color
- hasColors, -- :: IO Bool
-
- -- * Attributes
- Attr,
- attr0, setBold, setReverse,
- attrSet,
- attrPlus, -- :: Attr -> Attr -> Attr
-
- -- * error handling
- throwIfErr_, -- :: Num a => String -> IO a -> IO ()
-
- ) where
-
-#if HAVE_SIGNAL_H
-# include <signal.h>
-#endif
-
-import qualified Data.ByteString.Char8 as P
-
-import Prelude hiding (pi)
-import Data.Char (ord, chr)
-
-import Control.Monad (liftM, when)
-import Control.Concurrent (yield, threadWaitRead)
-
-import Foreign.C.Types (CInt, CShort)
-import Foreign.C.String (CString)
-import Foreign
-
-#ifdef SIGWINCH
-import System.Posix.Signals (installHandler, Signal, Handler(Catch))
-#endif
-
---
--- If we have the SIGWINCH signal, we use that, with a custom handler,
--- to determine when to resize the screen. Otherwise, we use a similar
--- handler that looks for KEY_RESIZE in the input stream -- the result
--- is a less responsive update, however.
---
-
-------------------------------------------------------------------------
---
--- | Start it all up
---
-initCurses :: IO () -> IO ()
-initCurses fn = do
- initScr
- b <- hasColors
- when b $ startColor >> useDefaultColors
- resetParams
-#ifdef SIGWINCH
- -- does this still work?
- installHandler cursesSigWinch (Catch fn) Nothing >> return ()
-#endif
-
--- | A bunch of settings we need
---
-resetParams :: IO ()
-resetParams = do
- cBreak True
- echo False -- don't echo to the screen
- nl True -- always translate enter to \n
- leaveOk True -- not ok to leave cursor wherever it is
- meta stdScr True -- ask for 8 bit chars, so we can get Meta
- keypad stdScr True -- enable the keypad, so things like ^L (refresh) work
- noDelay stdScr False -- blocking getCh, no #ERR
- return ()
-
--- not needed, if keypad is True:
--- defineKey (#const KEY_UP) "\x1b[1;2A"
--- defineKey (#const KEY_DOWN) "\x1b[1;2B"
--- defineKey (#const KEY_SLEFT) "\x1b[1;2D"
--- defineKey (#const KEY_SRIGHT) "\x1b[1;2C"
-
-------------------------------------------------------------------------
-
-fi :: (Integral a, Num b) => a -> b
-fi = fromIntegral
-{-# INLINE fi #-}
-
-------------------------------------------------------------------------
---
--- Error handling, packed to save on all those strings
---
-
--- | Like throwIf, but for packed error messages
-throwPackedIf :: (a -> Bool) -> P.ByteString -> (IO a) -> (IO a)
-throwPackedIf p msg action = do
- v <- action
- if p v then (fail . P.unpack $ msg) else return v
-{-# INLINE throwPackedIf #-}
-
--- | Arbitrary test
-throwIfErr :: Num a => P.ByteString -> IO a -> IO a
-throwIfErr = throwPackedIf (== (#const ERR))
-{-# INLINE throwIfErr #-}
-
--- | Discard result
-throwIfErr_ :: Num a => P.ByteString -> IO a -> IO ()
-throwIfErr_ a b = void $ throwIfErr a b
-{-# INLINE throwIfErr_ #-}
-
--- | packed throwIfNull
-throwPackedIfNull :: P.ByteString -> IO (Ptr a) -> IO (Ptr a)
-throwPackedIfNull = throwPackedIf (== nullPtr)
-{-# INLINE throwPackedIfNull #-}
-
-------------------------------------------------------------------------
-
-type WindowTag = ()
-type Window = Ptr WindowTag
-
---
--- | The standard screen
---
-stdScr :: Window
-stdScr = unsafePerformIO (peek stdscr)
-
-foreign import ccall "static &stdscr"
- stdscr :: Ptr Window
-
---
--- | initscr is normally the first curses routine to call when
--- initializing a program. curs_initscr(3):
---
--- > To initialize the routines, the routine initscr or newterm
--- > must be called before any of the other routines that deal
--- > with windows and screens are used.
---
--- > The initscr code determines the terminal type and initial-
--- > izes all curses data structures. initscr also causes the
--- > first call to refresh to clear the screen. If errors
--- > occur, initscr writes an appropriate error message to
--- > standard error and exits; otherwise, a pointer is returned
--- > to stdscr.
---
-initScr :: IO Window
-initScr = throwPackedIfNull (P.pack "initscr") c_initscr
-
-foreign import ccall unsafe "initscr"
- c_initscr :: IO Window
-
---
--- |> The cbreak routine
--- > disables line buffering and erase/kill character-process-
--- > ing (interrupt and flow control characters are unaf-
--- > fected), making characters typed by the user immediately
--- > available to the program. The nocbreak routine returns
--- > the terminal to normal (cooked) mode.
---
-cBreak :: Bool -> IO ()
-cBreak True = throwIfErr_ (P.pack "cbreak") cbreak
-cBreak False = throwIfErr_ (P.pack "nocbreak") nocbreak
-
-foreign import ccall unsafe "cbreak" cbreak :: IO CInt
-foreign import ccall unsafe "nocbreak" nocbreak :: IO CInt
-
---
--- |> The echo and noecho routines control whether characters
--- > typed by the user are echoed by getch as they are typed.
--- > Echoing by the tty driver is always disabled, but ini-
--- > tially getch is in echo mode, so characters typed are
--- > echoed. Authors of most interactive programs prefer to do
--- > their own echoing in a controlled area of the screen, or
--- > not to echo at all, so they disable echoing by calling
--- > noecho. [See curs_getch(3) for a discussion of how these
--- > routines interact with cbreak and nocbreak.]
---
-echo :: Bool -> IO ()
-echo False = throwIfErr_ (P.pack "noecho") noecho
-echo True = throwIfErr_ (P.pack "echo") echo_c
-
-foreign import ccall unsafe "noecho" noecho :: IO CInt
-foreign import ccall unsafe "echo" echo_c :: IO CInt
-
---
--- |> The nl and nonl routines control whether the underlying
--- > display device translates the return key into newline on
--- > input, and whether it translates newline into return and
--- > line-feed on output (in either case, the call addch('\n')
--- > does the equivalent of return and line feed on the virtual
--- > screen). Initially, these translations do occur. If you
--- > disable them using nonl, curses will be able to make bet-
--- > ter use of the line-feed capability, resulting in faster
--- > cursor motion. Also, curses will then be able to detect
--- > the return key.
--- >
-nl :: Bool -> IO ()
-nl True = throwIfErr_ (P.pack "nl") nl_c
-nl False = throwIfErr_ (P.pack "nonl") nonl
-
-foreign import ccall unsafe "nl" nl_c :: IO CInt
-foreign import ccall unsafe "nonl" nonl :: IO CInt
-
---
--- | Enable the keypad of the user's terminal.
---
-keypad :: Window -> Bool -> IO ()
-keypad win bf = throwIfErr_ (P.pack "keypad") $
- keypad_c win (if bf then 1 else 0)
-
-foreign import ccall unsafe "keypad"
- keypad_c :: Window -> (#type bool) -> IO CInt
-
--- |> The nodelay option causes getch to be a non-blocking call.
--- > If no input is ready, getch returns ERR. If disabled (bf
--- > is FALSE), getch waits until a key is pressed.
---
-noDelay :: Window -> Bool -> IO ()
-noDelay win bf = throwIfErr_ (P.pack "nodelay") $
- nodelay win (if bf then 1 else 0)
-
-foreign import ccall unsafe nodelay
- :: Window -> (#type bool) -> IO CInt
-
---
--- |> Normally, the hardware cursor is left at the location of
--- > the window cursor being refreshed. The leaveok option
--- > allows the cursor to be left wherever the update happens
--- > to leave it. It is useful for applications where the cur-
--- > sor is not used, since it reduces the need for cursor
--- > motions. If possible, the cursor is made invisible when
--- > this option is enabled.
---
-leaveOk :: Bool -> IO CInt
-leaveOk bf = leaveok_c stdScr (if bf then 1 else 0)
-
-foreign import ccall unsafe "leaveok"
- leaveok_c :: Window -> (#type bool) -> IO CInt
-
-------------------------------------------------------------------------
-
--- | The use_default_colors() and assume_default_colors() func-
--- tions are extensions to the curses library. They are used
--- with terminals that support ISO 6429 color, or equivalent.
---
--- use_default_colors() tells the curses library to assign terminal
--- default foreground/background colors to color number -1.
---
-#if defined(HAVE_USE_DEFAULT_COLORS)
-foreign import ccall unsafe "use_default_colors"
- useDefaultColors :: IO ()
-#else
-useDefaultColors :: IO ()
-useDefaultColors = return ()
-#endif
-
-------------------------------------------------------------------------
-
---
--- |> The program must call endwin for each terminal being used before
--- > exiting from curses.
---
-endWin :: IO ()
-endWin = throwIfErr_ (P.pack "endwin") endwin
-
-foreign import ccall unsafe "endwin"
- endwin :: IO CInt
-
-------------------------------------------------------------------------
-
---
--- | get the dimensions of the screen
---
-scrSize :: IO (Int, Int)
-scrSize = do
- lnes <- peek linesPtr
- cols <- peek colsPtr
- return (fi lnes, fi cols)
-
-foreign import ccall "&LINES" linesPtr :: Ptr CInt
-foreign import ccall "&COLS" colsPtr :: Ptr CInt
-
---
--- | refresh curses windows and lines. curs_refresh(3)
---
-refresh :: IO ()
-refresh = throwIfErr_ (P.pack "refresh") refresh_c
-
-foreign import ccall unsafe "refresh"
- refresh_c :: IO CInt
-
-------------------------------------------------------------------------
-
-hasColors :: IO Bool
-hasColors = liftM (/= 0) has_colors
-
-foreign import ccall unsafe "has_colors"
- has_colors :: IO (#type bool)
-
---
--- | Initialise the color settings, also sets the screen to the
--- default colors (white on black)
---
-startColor :: IO ()
-startColor = throwIfErr_ (P.pack "start_color") start_color
-
-foreign import ccall unsafe start_color :: IO CInt
-
-newtype Pair = Pair Int
-newtype Color = Color Int
-
-color :: String -> Maybe Color
-#if defined(HAVE_USE_DEFAULT_COLORS)
-color "default" = Just $ Color (-1)
-#endif
-color "black" = Just $ Color (#const COLOR_BLACK)
-color "red" = Just $ Color (#const COLOR_RED)
-color "green" = Just $ Color (#const COLOR_GREEN)
-color "yellow" = Just $ Color (#const COLOR_YELLOW)
-color "blue" = Just $ Color (#const COLOR_BLUE)
-color "magenta" = Just $ Color (#const COLOR_MAGENTA)
-color "cyan" = Just $ Color (#const COLOR_CYAN)
-color "white" = Just $ Color (#const COLOR_WHITE)
-color _ = Just $ Color (#const COLOR_BLACK) -- NB
-
---
--- |> curses support color attributes on terminals with that
--- > capability. To use these routines start_color must be
--- > called, usually right after initscr. Colors are always
--- > used in pairs (referred to as color-pairs). A color-pair
--- > consists of a foreground color (for characters) and a
--- > background color (for the blank field on which the charac-
--- > ters are displayed). A programmer initializes a color-
--- > pair with the routine init_pair. After it has been ini-
--- > tialized, COLOR_PAIR(n), a macro defined in <curses.h>,
--- > can be used as a new video attribute.
---
--- > If a terminal is capable of redefining colors, the pro-
--- > grammer can use the routine init_color to change the defi-
--- > nition of a color.
---
--- > The init_pair routine changes the definition of a color-
--- > pair. It takes three arguments: the number of the color-
--- > pair to be changed, the foreground color number, and the
--- > background color number. For portable applications:
---
--- > - The value of the first argument must be between 1 and
--- > COLOR_PAIRS-1.
---
--- > - The value of the second and third arguments must be
--- > between 0 and COLORS (the 0 color pair is wired to
--- > white on black and cannot be changed).
---
---
-initPair :: Pair -> Color -> Color -> IO ()
-initPair (Pair p) (Color f) (Color b) =
- throwIfErr_ (P.pack "init_pair") $
- init_pair (fi p) (fi f) (fi b)
-
-foreign import ccall unsafe
- init_pair :: CShort -> CShort -> CShort -> IO CInt
-
--- ---------------------------------------------------------------------
--- Attributes. Keep this as simple as possible for maximum portability
-
-foreign import ccall unsafe "attrset"
- c_attrset :: CInt -> IO CInt
-
-attrSet :: Attr -> Pair -> IO ()
-attrSet (Attr attr) (Pair p) = do
- throwIfErr_ (P.pack "attrset") $ c_attrset (attr .|. fi (colorPair p))
-
-------------------------------------------------------------------------
-
-newtype Attr = Attr CInt
-
-attr0 :: Attr
-attr0 = Attr (#const A_NORMAL)
-
-setBold :: Attr -> Bool -> Attr
-setBold = setAttr (Attr #const A_BOLD)
-
-setReverse :: Attr -> Bool -> Attr
-setReverse = setAttr (Attr #const A_REVERSE)
-
--- | bitwise combination of attributes
-setAttr :: Attr -> Attr -> Bool -> Attr
-setAttr (Attr b) (Attr a) False = Attr (a .&. complement b)
-setAttr (Attr b) (Attr a) True = Attr (a .|. b)
-
-attrPlus :: Attr -> Attr -> Attr
-attrPlus (Attr a) (Attr b) = Attr (a .|. b)
-
-------------------------------------------------------------------------
-
-#let translate_attr attr = \
- "(if a .&. %lu /= 0 then %lu else 0) .|.", \
- (unsigned long) A_##attr, (unsigned long) A_##attr
-
-bkgrndSet :: Attr -> Pair -> IO ()
-bkgrndSet (Attr a) (Pair p) = bkgdset $
- fi (ord ' ') .|.
- #translate_attr ALTCHARSET
- #translate_attr BLINK
- #translate_attr BOLD
- #translate_attr DIM
- #translate_attr INVIS
- #translate_attr PROTECT
- #translate_attr REVERSE
- #translate_attr STANDOUT
- #translate_attr UNDERLINE
- colorPair p
-
-foreign import ccall unsafe "get_color_pair"
- colorPair :: Int -> (#type chtype)
-
-foreign import ccall unsafe bkgdset :: (#type chtype) -> IO ()
-
-------------------------------------------------------------------------
-
-foreign import ccall threadsafe
- waddnstr :: Window -> CString -> CInt -> IO CInt
-
-clrToEol :: IO ()
-clrToEol = throwIfErr_ (P.pack "clrtoeol") c_clrtoeol
-
-foreign import ccall unsafe "clrtoeol" c_clrtoeol :: IO CInt
-
---
--- | > move the cursor associated with the window
--- > to line y and column x. This routine does not move the
--- > physical cursor of the terminal until refresh is called.
--- > The position specified is relative to the upper left-hand
--- > corner of the window, which is (0,0).
---
-wMove :: Window -> Int -> Int -> IO ()
-wMove w y x = throwIfErr_ (P.pack "wmove") $ wmove w (fi y) (fi x)
-
-foreign import ccall unsafe
- wmove :: Window -> CInt -> CInt -> IO CInt
-
--- ---------------------------------------------------------------------
--- Cursor routines
-
-data CursorVisibility = CursorInvisible | CursorVisible | CursorVeryVisible
-
---
--- | Set the cursor state
---
--- > The curs_set routine sets the cursor state is set to
--- > invisible, normal, or very visible for visibility equal to
--- > 0, 1, or 2 respectively. If the terminal supports the
--- > visibility requested, the previous cursor state is
--- > returned; otherwise, ERR is returned.
---
-cursSet :: CInt -> IO CInt
-cursSet 0 = leaveOk True >> curs_set 0
-cursSet n = leaveOk False >> curs_set n
-
-foreign import ccall unsafe "curs_set"
- curs_set :: CInt -> IO CInt
-
---
--- | Get the current cursor coordinates
---
-getYX :: Window -> IO (Int, Int)
-getYX w =
- alloca $ \py -> -- allocate two ints on the stack
- alloca $ \px -> do
- nomacro_getyx w py px -- writes current cursor coords
- y <- peek py
- x <- peek px
- return (fi y, fi x)
-
---
--- | Get the current cursor coords, written into the two argument ints.
---
--- > The getyx macro places the current cursor position of the given
--- > window in the two integer variables y and x.
---
--- void getyx(WINDOW *win, int y, int x);
---
-foreign import ccall unsafe "nomacro_getyx"
- nomacro_getyx :: Window -> Ptr CInt -> Ptr CInt -> IO ()
-
---
--- | > The getch, wgetch, mvgetch and mvwgetch, routines read a
--- > character from the window.
---
-foreign import ccall threadsafe getch :: IO CInt
-
-------------------------------------------------------------------------
---
--- | Map curses keys to real chars. The lexer will like this.
---
-decodeKey :: CInt -> Char
-decodeKey = chr . fi
-{-# INLINE decodeKey #-}
-
---
--- | Some constants for easy symbolic manipulation.
--- NB we don't map keys to an abstract type anymore, as we can't use
--- Alex lexers then.
---
-keyDown :: Char
-keyDown = chr (#const KEY_DOWN)
-keyUp :: Char
-keyUp = chr (#const KEY_UP)
-keyLeft :: Char
-keyLeft = chr (#const KEY_LEFT)
-keyRight :: Char
-keyRight = chr (#const KEY_RIGHT)
-
-keyHome :: Char
-keyHome = chr (#const KEY_HOME)
-keyBackspace :: Char
-keyBackspace = chr (#const KEY_BACKSPACE)
-
-keyNPage :: Char
-keyNPage = chr (#const KEY_NPAGE)
-keyPPage :: Char
-keyPPage = chr (#const KEY_PPAGE)
-keyEnd :: Char
-keyEnd = chr (#const KEY_END)
-
-#ifdef KEY_RESIZE
--- ncurses sends this
-keyResize :: Char
-keyResize = chr (#const KEY_RESIZE)
-#endif
-
--- ---------------------------------------------------------------------
--- try to set the upper bits
-
-meta :: Window -> Bool -> IO ()
-meta win bf = throwIfErr_ (P.pack "meta") $
- c_meta win (if bf then 1 else 0)
-
-foreign import ccall unsafe "meta"
- c_meta :: Window -> CInt -> IO CInt
-
-------------------------------------------------------------------------
---
--- | read a character from the window
---
--- When 'ESC' followed by another key is pressed before the ESC timeout,
--- that second character is not returned until a third character is
--- pressed. wtimeout, nodelay and timeout don't appear to change this
--- behaviour.
---
--- On emacs, we really would want Alt to be our meta key, I think.
---
--- Be warned, getCh will block the whole process without noDelay
---
-getCh :: IO Char
-getCh = do
- threadWaitRead 0
- v <- getch
- case v of
- (#const ERR) -> yield >> getCh
- x -> return $ decodeKey x
-
-------------------------------------------------------------------------
-
-#ifdef SIGWINCH
-cursesSigWinch :: Signal
-cursesSigWinch = #const SIGWINCH
-#endif
-
View
58 cbits/config.h.in
@@ -1,58 +0,0 @@
-/* cbits/config.h.in. Generated from configure.ac by autoheader. */
-
-/* Define to 1 if you have the <inttypes.h> header file. */
-#undef HAVE_INTTYPES_H
-
-/* Define to 1 if you have the `curses' library (-lcurses). */
-#undef HAVE_LIBCURSES
-
-/* Define to 1 if you have the <memory.h> header file. */
-#undef HAVE_MEMORY_H
-
-/* Define to 1 if you have the <regex.h> header file. */
-#undef HAVE_REGEX_H
-
-/* Define to 1 if you have the <stdint.h> header file. */
-#undef HAVE_STDINT_H
-
-/* Define to 1 if you have the <stdlib.h> header file. */
-#undef HAVE_STDLIB_H
-
-/* Define to 1 if you have the <strings.h> header file. */
-#undef HAVE_STRINGS_H
-
-/* Define to 1 if you have the <string.h> header file. */
-#undef HAVE_STRING_H
-
-/* Define to 1 if you have the <sys/stat.h> header file. */
-#undef HAVE_SYS_STAT_H
-
-/* Define to 1 if you have the <sys/types.h> header file. */
-#undef HAVE_SYS_TYPES_H
-
-/* Define to 1 if you have the <unistd.h> header file. */
-#undef HAVE_UNISTD_H
-
-/* Define to 1 if you have the `use_default_colors' function. */
-#undef HAVE_USE_DEFAULT_COLORS
-
-/* Define to the address where bug reports for this package should be sent. */
-#undef PACKAGE_BUGREPORT
-
-/* Define to the full name of this package. */
-#undef PACKAGE_NAME
-
-/* Define to the full name and version of this package. */
-#undef PACKAGE_STRING
-
-/* Define to the one symbol short name of this package. */
-#undef PACKAGE_TARNAME
-
-/* Define to the version of this package. */
-#undef PACKAGE_VERSION
-
-/* Current patch count */
-#undef PATCH_COUNT
-
-/* Define to 1 if you have the ANSI C header files. */
-#undef STDC_HEADERS
View
86 cbits/utils.c
@@ -1,86 +0,0 @@
-
-#include "utils.h"
-
-/*
- * A non-macro version of getyx(3), to make writing a Haskell binding
- * easier. Called in Yi/Curses.hsc
- */
-void nomacro_getyx(WINDOW *win, int *y, int *x) {
- getyx(win, *y, *x);
-}
-
-/* A non-macro version of COLOR_PAIR(3)
- */
-int get_color_pair (int pair) {
- return COLOR_PAIR (pair);
-}
-
-/*
- * Specialised packed hGetLine. The caller should copy out any string it
- * is interested in. Additionally, we drop redundant @F packets arriving --
- * there's too many anyway
- *
- * Note that mpg321 (only) provides --skip-printing-frames=N
- * I guess we could have used that.
- */
-#define BUFLEN 1024
-
-#define DROPRATE 10
-
-int FRAME_COUNT = 0; /* we count frame packets, and drop 9/10 of them */
- /* setting this to 10 will force the next
- * packet to be returned, no matter what */
-
-/* when skipping frames, we want to ensure we don't drop any packets,
- * for reasonable performance on updates. This trick does that */
-void forcenext(void) {
- FRAME_COUNT = DROPRATE ;
-}
-
-/* sometimes we write to the wrong spot after a refresh */
-int getline(char *buf, FILE *hdl) {
- char *p;
- int c;
-
- /* read first two bytes of packet, to work out if we drop it */
- getc(hdl); /* should be '@' */
- c = getc(hdl);
-
- /* drop packet */
- if (c == 'F' && FRAME_COUNT < DROPRATE ) {
- FRAME_COUNT++;
-
- while (c != '\n')
- c = getc(hdl);
- return getline(buf,hdl); /* read another line */
-
- /* normal packet */
- } else {
- if (c == 'F') FRAME_COUNT = 0; /* reset frame count */
-
- p = fgets(buf+1, BUFLEN-1, hdl); /* read rest of line */
- if (p == NULL) {
- // perror("getline failed\n");
- return (-1);
- }
- buf[0] = c; /* drop the '@' */
- return strlen(buf); /* return length so we can realloc */
- }
-}
-
-/* given a file descriptor (presumably got from a Haskell Handle) , open
- * a FILE * stream onto that fd. Don't try to use the Handle after this
- *
- * could be done in Haskell...
- */
-FILE *openfd(int fd) {
- FILE *file = NULL;
-
- if ((file = fdopen(fd, "r")) != NULL) {
- return file;
- } else {
- perror("cbits.openfd failed\n\n");
- close(fd);
- return NULL;
- }
-}
View
16 cbits/utils.h
@@ -1,16 +0,0 @@
-#include <string.h>
-#include <stdio.h>
-#include <unistd.h>
-#include <errno.h>
-#include <curses.h>
-
-#include "config.h"
-
-/* curses */
-extern void nomacro_getyx(WINDOW *win, int *y, int *x);
-extern int get_color_pair (int pair);
-
-/* packed string IO */
-FILE *openfd(int fd);
-int getline(char *buf, FILE *hdl);
-void forcenext(void);
View
19 configure.ac
@@ -1,19 +0,0 @@
-
-AC_INIT(Curses.hsc)
-AC_CONFIG_HEADERS([cbits/config.h])
-AC_PREREQ([2.52])
-
-# Some libs we need
-AC_CHECK_LIB(curses, addnstr)
-AC_CHECK_FUNCS(use_default_colors)
-AC_CHECK_HEADERS([regex.h sys/types.h])
-
-# And now a trick to get the current patch count:
-if test -d "_darcs" ; then
- PATCH_COUNT_=`darcs changes --xml-output | sed -n '/^<patch/p;/TAG/q' | wc -l | sed 's/ *//g'`
-else
- PATCH_COUNT_=""
-fi
-AC_DEFINE_UNQUOTED(PATCH_COUNT, "$PATCH_COUNT_", [Current patch count])
-
-AC_OUTPUT
Please sign in to comment.
Something went wrong with that request. Please try again.