{-# LINE 1 "UI/HSCurses/Curses.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}

-- Copyright (c) 2002-2004 John Meacham (john at repetae dot net)
-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- Copyright (c) 2005-2011 Stefan Wehr - http://www.stefanwehr.de
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

-- | 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/>
--
-- N.B attrs don't work with Irix curses.h. This should be fixed.
module UI.HSCurses.Curses (
    -- Basic Functions
    stdScr,
    initScr,
    initCurses,
    resetParams,
    endWin,
    scrSize,
    newTerm,
    delScreen,

    -- Windows, screens and Pads
    Screen,
    Window,
    Border (..),
    touchWin,
    newPad,
    pRefresh,
    delWin,
    newWin,
    wRefresh,
    wnoutRefresh,
    wBorder,
    defaultBorder,

    -- Refresh routines
    refresh,
    update,
    resizeTerminal,
    timeout,
    noqiflush,

    -- Navigation
    move,
    getYX,

    -- Input
    getCh,
    getch,
    decodeKey,
    ungetCh,
    keyResizeCode,

    -- * Input Options
    cBreak, -- :: Bool -> IO ()
    raw, -- :: Bool -> IO ()
    echo, -- :: Bool -> IO ()
    intrFlush, -- :: Bool -> IO ()
    keypad, -- :: Window -> Bool -> IO ()
    noDelay, -- :: Window -> Bool -> IO ()

    -- * Output
    wAddStr, -- :: Window -> String -> IO ()
    addLn, -- :: IO ()
    mvWAddStr,
    mvAddCh, -- :: Int -> Int -> ChType -> IO ()
    wMove,
    bkgrndSet, -- :: Attr -> Pair -> IO ()
    erase, -- :: IO ()
    wclear, -- :: Window -> IO ()
    werase,
    clrToEol, -- :: IO ()
    wClrToEol,
    beep,
    waddch,
    winsch,
    waddchnstr, -- :: Window -> CString -> CInt -> IO CInt

    -- * Output Options
    clearOk,
    leaveOk,
    nl, -- :: Bool -> IO ()

    -- * Cursor Routines
    CursorVisibility (..),
    cursSet,

    -- * Color Support
    hasColors, -- :: IO Bool
    startColor, -- :: IO ()
    useDefaultColors, -- :: IO ()
    Pair (..), -- newtype Pair = Pair Int deriving (Eq, Ord, Ix)
    colorPairs, -- :: IO Int
    Color (..), -- newtype Color = Color Int deriving (Eq, Ord, Ix)
    colors, -- :: IO Int
    color, -- :: String -> Maybe Color
    --    black, red, green, yellow, blue, magenta, cyan, white, -- :: Color
    initPair, -- :: Pair -> Color -> Color -> IO ()
    pairContent, -- :: Pair -> IO (Color, Color)
    canChangeColor, -- :: IO Bool
    initColor, -- :: Color -> (Int, Int, Int) -> IO ()
    colorContent, -- :: Color -> IO (Int, Int, Int)
    defaultBackground,
    defaultForeground,

    -- * Attributes
    attrPlus,
    Attr,
    attr0, -- :: Attr
    isAltCharset,
    isBlink,
    isBold,
    isDim,
    isHorizontal,
    isInvis,
    isLeft,
    isLow,
    isProtect,
    isReverse,
    isRight,
    isStandout,
    isTop,
    isUnderline,
    isVertical,
    -- :: Attr -> Bool

    setAltCharset,
    setBlink,
    setBold,
    setDim,
    setHorizontal,
    setInvis,
    setLeft,
    setLow,
    setProtect,
    setReverse,
    setRight,
    setStandout,
    setTop,
    setUnderline,
    setVertical,
    -- :: Attr -> Bool -> Attr

    attrSet, -- :: Attr -> Pair -> IO ()
    attrOn,
    attrOff,
    standout,
    standend,
    attrDim,
    attrBold,
    attrDimOn,
    attrDimOff,
    attrBoldOn,
    attrBoldOff,
    wAttrOn,
    wAttrOff,
    wAttrSet,
    wAttrGet,

    -- * Mouse Routines
    getMouse,
    withMouseEventMask,
    withAllMouseEvents,
    ButtonEvent (..),
    MouseEvent (..),

    -- * Keys
    Key (..),
    cERR,
    cKEY_UP,
    cKEY_DOWN,
    cKEY_LEFT,
    cKEY_RIGHT,
    cTRUE,
    --    cACS_BLOCK,

    -- * Lines
    vline,
    ulCorner,
    llCorner,
    urCorner,
    lrCorner,
    rTee,
    lTee,
    bTee,
    tTee,
    hLine,
    vLine,
    plus,
    s1,
    s9,
    diamond,
    ckBoard,
    degree,
    plMinus,
    bullet,
    lArrow,
    rArrow,
    dArrow,
    uArrow,
    board,
    lantern,
    block,
    s3,
    s7,
    lEqual,
    gEqual,
    pi,
    nEqual,
    sterling,

    -- * Signals
    cursesSigWinch,

    -- * Misc
    cursesTest,
    throwIfErr,
    throwIfErr_,
    errI, -- :: IO CInt -> IO ()
    flushinp,
    recognize,
    ChType,
    NBool,
) where




{-# LINE 255 "UI/HSCurses/Curses.hsc" #-}


{-# LINE 257 "UI/HSCurses/Curses.hsc" #-}

import UI.HSCurses.Logging


{-# LINE 265 "UI/HSCurses/Curses.hsc" #-}

import Data.Char
import Data.Ix (Ix)
import Prelude hiding (pi)

-- foldl' was put into Prelude in base 4.20

{-# LINE 274 "UI/HSCurses/Curses.hsc" #-}

import System.IO.Unsafe (unsafePerformIO)

import Control.Concurrent
import Control.Monad (liftM, void, when)
import Control.Monad.Trans


{-# LINE 284 "UI/HSCurses/Curses.hsc" #-}
import Foreign hiding (void)

{-# LINE 286 "UI/HSCurses/Curses.hsc" #-}

import Foreign.C.Error
import Foreign.C.String
import Foreign.C.Types

import GHC.IO.FD (FD (..))


{-# LINE 294 "UI/HSCurses/Curses.hsc" #-}
import System.Posix.Signals

{-# LINE 296 "UI/HSCurses/Curses.hsc" #-}


{-# LINE 300 "UI/HSCurses/Curses.hsc" #-}


-- | 'initCurses' does all initialization necessary for a Curses application.
initCurses :: IO ()
initCurses :: IO ()
initCurses = do
    IO Window
initScr
    b <- IO Bool
hasColors
    when b $ startColor >> useDefaultColors

resetParams :: IO ()
resetParams :: IO ()
resetParams = do
    Bool -> IO ()
raw Bool
True -- raw mode please
    Bool -> IO ()
echo Bool
False
    Bool -> IO ()
nl Bool
False
    Bool -> IO ()
intrFlush Bool
True
    Bool -> IO Signal
leaveOk Bool
False
    Window -> Bool -> IO ()
keypad Window
stdScr Bool
True

{-# LINE 318 "UI/HSCurses/Curses.hsc" #-}
    defineKey (259) "\x1b[1;2A"
{-# LINE 319 "UI/HSCurses/Curses.hsc" #-}
    defineKey (258) "\x1b[1;2B"
{-# LINE 320 "UI/HSCurses/Curses.hsc" #-}
    defineKey (393) "\x1b[1;2D"
{-# LINE 321 "UI/HSCurses/Curses.hsc" #-}
    defineKey (402) "\x1b[1;2C"
{-# LINE 322 "UI/HSCurses/Curses.hsc" #-}
    defineKey (350) "\x1b[E" -- xterm seems to emit B2, not BEG
{-# LINE 323 "UI/HSCurses/Curses.hsc" #-}
    defineKey (360) "\x1b[F"
{-# LINE 324 "UI/HSCurses/Curses.hsc" #-}
    defineKey (360) "\x1b[4~"
{-# LINE 325 "UI/HSCurses/Curses.hsc" #-}
    defineKey (262) "\x1b[H"
{-# LINE 326 "UI/HSCurses/Curses.hsc" #-}
    defineKey (262) "\x1b[1~"
{-# LINE 327 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 328 "UI/HSCurses/Curses.hsc" #-}

fi :: (Integral a, Num b) => a -> b
fi :: forall a b. (Integral a, Num b) => a -> b
fi = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral

throwIfErr :: (Eq a, Show a, Num a) => String -> IO a -> IO a
throwIfErr :: forall a. (Eq a, Show a, Num a) => String -> IO a -> IO a
throwIfErr String
s = (a -> Bool) -> (a -> String) -> IO a -> IO a
forall a. (a -> Bool) -> (a -> String) -> IO a -> IO a
throwIf (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (-a
1)) (\a
a -> String
"Curses[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
{-# LINE 334 "UI/HSCurses/Curses.hsc" #-}

throwIfErr_ :: (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ :: forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
name IO a
act = IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO a -> IO a
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO a
throwIfErr String
name IO a
act

errI :: IO CInt -> IO ()
errI :: IO Signal -> IO ()
errI IO Signal
f = do
    r <- IO Signal
f
    if r == cERR
        then do
            _ <- endwin
            error "curses returned an error"
        else return ()

type WindowTag = ()
type Window = Ptr WindowTag
type ChType = Word32
{-# LINE 350 "UI/HSCurses/Curses.hsc" #-}
type NBool = Word8
{-# LINE 351 "UI/HSCurses/Curses.hsc" #-}


-- | The standard screen
stdScr :: Window
stdScr :: Window
stdScr = IO Window -> Window
forall a. IO a -> a
unsafePerformIO (Ptr Window -> IO Window
forall a. Storable a => Ptr a -> IO a
peek Ptr Window
stdscr)
{-# NOINLINE stdScr #-}

foreign import ccall "static HSCurses.h &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 :: IO Window
initScr = String -> IO Window -> IO Window
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull String
"initscr" IO Window
initscr

foreign import ccall unsafe "HSCurses.h initscr" initscr :: IO Window

-- This seems like the easiest way to get a FILE (see: man FILE)
-- from an FD
type FILE = Ptr ()

foreign import ccall unsafe "fdopen"
    fdopen :: CInt -> CString -> IO FILE

fdOpen :: FD -> String -> IO FILE
fdOpen :: FD -> String -> IO Window
fdOpen FD
fd String
mode =
    String -> (CString -> IO Window) -> IO Window
forall a. String -> (CString -> IO a) -> IO a
withCString String
mode ((CString -> IO Window) -> IO Window)
-> (CString -> IO Window) -> IO Window
forall a b. (a -> b) -> a -> b
$ \CString
mode' -> do
        Signal -> CString -> IO Window
fdopen (FD -> Signal
fdFD FD
fd) CString
mode'

type Screen = Ptr ()

-- | A program that outputs to more than one terminal should use the 'newTerm'
-- routine for each terminal instead of 'initScr'. A program that needs to
-- inspect capabilities, so it can continue to run in a line-oriented mode if
-- the terminal cannot support a screen-oriented program, would also use
-- 'newTerm'. curs_initscr(3X):
--
-- >    The routine newterm should be called once for each terminal. It returns
-- >    a variable of type SCREEN * which should be saved as a reference to that
-- >    terminal. newterm's arguments are
-- >
-- >    - the type of the terminal to be used in place of $TERM,
-- >
-- >    - an output stream connected to the terminal, and
-- >
-- >    - an input stream connected to the terminal
-- >
-- >    If the type parameter is NULL, $TERM will be used.
newTerm :: String -> FD -> FD -> IO Screen
newTerm :: String -> FD -> FD -> IO Window
newTerm String
typ FD
out FD
in' =
    String -> (CString -> IO Window) -> IO Window
forall a. String -> (CString -> IO a) -> IO a
withCString String
typ ((CString -> IO Window) -> IO Window)
-> (CString -> IO Window) -> IO Window
forall a b. (a -> b) -> a -> b
$ \CString
typ' -> do
        fout <- FD -> String -> IO Window
fdOpen FD
out String
"rw"
        fin <- fdOpen in' "r"
        throwIfNull "newterm" $ newterm typ' fout fin

foreign import ccall unsafe "HSCurses.h newterm"
    newterm :: CString -> FILE -> FILE -> IO Screen

foreign import ccall unsafe "HSCurses.h delscreen"
    delScreen :: Screen -> IO ()

-- | > The cbreak routine disables line buffering and erase/kill
--   > character-processing (interrupt and flow control characters are
--   > unaffected), 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 :: Bool -> IO ()
cBreak Bool
True = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"cbreak" IO Signal
cbreak
cBreak Bool
False = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"nocbreak" IO Signal
nocbreak

foreign import ccall unsafe "HSCurses.h cbreak"     cbreak :: IO CInt
foreign import ccall unsafe "HSCurses.h nocbreak" nocbreak :: IO CInt

-- | > The raw and noraw routines place the terminal into or out of raw mode.
--   > Raw mode is similar to cbreak mode, in that characters typed are
--   > immediately passed through to the user program. The differences are that
--   > in raw mode, the interrupt, quit, suspend, and flow control characters
--   > are all passed through uninterpreted, instead of generating a signal. The
--   > behavior of the BREAK key depends on other bits in the tty driver that
--   > are not set by curses.
raw :: Bool -> IO ()
raw :: Bool -> IO ()
raw Bool
False = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"noraw" IO Signal
noraw
raw Bool
True = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"raw" IO Signal
raw_c

foreign import ccall unsafe "hscurses.h noraw" noraw :: IO CInt
foreign import ccall unsafe "HSCurses.h raw" raw_c :: 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 :: Bool -> IO ()
echo Bool
False = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"noecho" IO Signal
noecho
echo Bool
True = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"echo" IO Signal
echo_c

foreign import ccall unsafe "HSCurses.h noecho" noecho :: IO CInt
foreign import ccall unsafe "HSCurses.h 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 :: Bool -> IO ()
nl Bool
True = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"nl" IO Signal
nl_c
nl Bool
False = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"nonl" IO Signal
nonl

foreign import ccall unsafe "HSCurses.h nl" nl_c :: IO CInt
foreign import ccall unsafe "HSCurses.h nonl" nonl :: IO CInt

-- | > If the intrflush option is enabled, (bf is TRUE), when an interrupt key
--   > is pressed on the keyboard (interrupt, break, quit) all output in the tty
--   > driver queue will be flushed, giving the effect of faster response to the
--   > interrupt, but causing curses to have the wrong idea of what is on the
--   > screen. Disabling (bf is FALSE), the option prevents the flush.
intrFlush :: Bool -> IO ()
intrFlush :: Bool -> IO ()
intrFlush Bool
bf =
    String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"intrflush" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> NBool -> IO Signal
intrflush Window
stdScr (if Bool
bf then NBool
1 else NBool
0)

foreign import ccall unsafe "HSCurses.h intrflush"
    intrflush :: Window -> (Word8) -> IO CInt
{-# LINE 487 "UI/HSCurses/Curses.hsc" #-}

-- | Enable the keypad of the user's terminal.
keypad :: Window -> Bool -> IO ()
keypad :: Window -> Bool -> IO ()
keypad Window
win Bool
bf = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"keypad" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> NBool -> IO Signal
keypad_c Window
win (if Bool
bf then NBool
1 else NBool
0)

foreign import ccall unsafe "HSCurses.h keypad"
    keypad_c :: Window -> (Word8) -> IO CInt
{-# LINE 494 "UI/HSCurses/Curses.hsc" #-}

noDelay :: Window -> Bool -> IO ()
noDelay :: Window -> Bool -> IO ()
noDelay Window
win Bool
bf =
    String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"nodelay" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> NBool -> IO Signal
nodelay Window
win (if Bool
bf then NBool
1 else NBool
0)

foreign import ccall unsafe "HSCurses.h nodelay"
    nodelay :: Window -> (Word8) -> IO CInt
{-# LINE 501 "UI/HSCurses/Curses.hsc" #-}

-- | 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 cursor 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 :: Bool -> IO Signal
leaveOk Bool
True = Window -> NBool -> IO Signal
leaveok_c Window
stdScr NBool
1
leaveOk Bool
False = Window -> NBool -> IO Signal
leaveok_c Window
stdScr NBool
0

foreign import ccall unsafe "HSCurses.h leaveok"
    leaveok_c :: Window -> (Word8) -> IO CInt
{-# LINE 513 "UI/HSCurses/Curses.hsc" #-}

clearOk :: Bool -> IO CInt
clearOk :: Bool -> IO Signal
clearOk Bool
True = Window -> NBool -> IO Signal
clearok_c Window
stdScr NBool
1
clearOk Bool
False = Window -> NBool -> IO Signal
clearok_c Window
stdScr NBool
0

foreign import ccall unsafe "HSCurses.h clearok"
    clearok_c :: Window -> (Word8) -> IO CInt
{-# LINE 520 "UI/HSCurses/Curses.hsc" #-}

foreign import ccall unsafe "HSCurses.h use_default_colors"
    useDefaultColors :: IO ()

defaultBackground, defaultForeground :: Color
defaultBackground :: Color
defaultBackground = Int -> Color
Color (-Int
1)
defaultForeground :: Color
defaultForeground = Int -> Color
Color (-Int
1)


{-# LINE 529 "UI/HSCurses/Curses.hsc" #-}
defineKey :: CInt -> String -> IO ()
defineKey :: Signal -> String -> IO ()
defineKey Signal
k String
s = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
s (\CString
s' -> CString -> Signal -> IO ()
define_key CString
s' Signal
k) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

foreign import ccall unsafe "HSCurses.h define_key"
    define_key :: Ptr CChar -> CInt -> IO ()

{-# LINE 535 "UI/HSCurses/Curses.hsc" #-}

-- | >  The program must call endwin for each terminal being used before
--   >  exiting from curses.
endWin :: IO ()
endWin :: IO ()
endWin = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"endwin" IO Signal
endwin

foreign import ccall unsafe "HSCurses.h endwin" endwin :: IO CInt

-- | Get the dimensions of the screen (lines, cols).
scrSize :: IO (Int, Int)
-- Note, per the documentation:
--    http://invisible-island.net/ncurses/ncurses-intro.html#caution
-- It is not recommended to peek at the LINES and COLS global variables.  This code
-- was previously doing exactly that, but now it is fixed to use getmaxyx.
--   -Ryan Newton [2013.03.31]
scrSize :: IO (Int, Int)
scrSize = do
    yfp <- IO (ForeignPtr Signal)
forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
    xfp <- mallocForeignPtr
    withForeignPtr yfp $ \Ptr Signal
yp ->
        ForeignPtr Signal -> (Ptr Signal -> IO (Int, Int)) -> IO (Int, Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Signal
xfp ((Ptr Signal -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr Signal -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Signal
xp -> do
            Window -> Ptr Signal -> Ptr Signal -> IO ()
getMaxYX Window
stdScr Ptr Signal
yp Ptr Signal
xp
            y <- Ptr Signal -> IO Signal
forall a. Storable a => Ptr a -> IO a
peek Ptr Signal
yp
            x <- peek xp
            return (fromIntegral y, fromIntegral x)
    
foreign import ccall "HSCurses.h getmaxyx_fun"
    getMaxYX ::
        Window -> Ptr CInt -> Ptr CInt -> IO ()

-- | Refresh curses windows and lines. curs_refresh(3)
refresh :: IO ()
refresh :: IO ()
refresh = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"refresh" IO Signal
refresh_c

foreign import ccall unsafe "HSCurses.h refresh"
    refresh_c :: IO CInt

-- | Refresh the specified window, copying the data from the virtual screen to
-- the physical screen.
wRefresh :: Window -> IO ()
wRefresh :: Window -> IO ()
wRefresh Window
w = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"wrefresh" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> IO Signal
wrefresh_c Window
w

foreign import ccall unsafe "HSCurses.h wrefresh"
    wrefresh_c :: Window -> IO CInt

-- | Stage an update to a window, but don't actually do the refresh until update
-- is called. This allows multiple windows to be updated together more smoothly.
wnoutRefresh :: Window -> IO ()
wnoutRefresh :: Window -> IO ()
wnoutRefresh Window
w = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"wnoutrefresh" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> IO Signal
wnoutrefresh_c Window
w

foreign import ccall safe "HSCurses.h wnoutrefresh"
    wnoutrefresh_c :: Window -> IO CInt

-- | Do an actual update. Used after endWin on linux to restore the terminal.
update :: IO ()
update :: IO ()
update = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"update" IO Signal
update_c

foreign import ccall unsafe "HSCurses.h doupdate" update_c :: IO CInt

foreign import ccall unsafe "static curses.h timeout" timeout_c :: CInt -> IO ()

-- | Set a delay in milliseconds.
timeout :: Int -> IO ()
timeout :: Int -> IO ()
timeout = Signal -> IO ()
timeout_c (Signal -> IO ()) -> (Int -> Signal) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral

hasColors :: IO Bool
hasColors :: IO Bool
hasColors = (NBool -> Bool) -> IO NBool -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (NBool -> NBool -> Bool
forall a. Eq a => a -> a -> Bool
/= NBool
0) IO NBool
has_colors

foreign import ccall unsafe "HSCurses.h has_colors" has_colors :: IO (Word8)
{-# LINE 603 "UI/HSCurses/Curses.hsc" #-}

-- | Initialise the color settings. Also sets the screen to the default colors
-- (white on black).
startColor :: IO ()
startColor :: IO ()
startColor = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"start_color" IO Signal
start_color

foreign import ccall unsafe start_color :: IO CInt

newtype Pair = Pair Int deriving (Pair -> Pair -> Bool
(Pair -> Pair -> Bool) -> (Pair -> Pair -> Bool) -> Eq Pair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pair -> Pair -> Bool
== :: Pair -> Pair -> Bool
$c/= :: Pair -> Pair -> Bool
/= :: Pair -> Pair -> Bool
Eq, Eq Pair
Eq Pair =>
(Pair -> Pair -> Ordering)
-> (Pair -> Pair -> Bool)
-> (Pair -> Pair -> Bool)
-> (Pair -> Pair -> Bool)
-> (Pair -> Pair -> Bool)
-> (Pair -> Pair -> Pair)
-> (Pair -> Pair -> Pair)
-> Ord Pair
Pair -> Pair -> Bool
Pair -> Pair -> Ordering
Pair -> Pair -> Pair
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Pair -> Pair -> Ordering
compare :: Pair -> Pair -> Ordering
$c< :: Pair -> Pair -> Bool
< :: Pair -> Pair -> Bool
$c<= :: Pair -> Pair -> Bool
<= :: Pair -> Pair -> Bool
$c> :: Pair -> Pair -> Bool
> :: Pair -> Pair -> Bool
$c>= :: Pair -> Pair -> Bool
>= :: Pair -> Pair -> Bool
$cmax :: Pair -> Pair -> Pair
max :: Pair -> Pair -> Pair
$cmin :: Pair -> Pair -> Pair
min :: Pair -> Pair -> Pair
Ord, Ord Pair
Ord Pair =>
((Pair, Pair) -> [Pair])
-> ((Pair, Pair) -> Pair -> Int)
-> ((Pair, Pair) -> Pair -> Int)
-> ((Pair, Pair) -> Pair -> Bool)
-> ((Pair, Pair) -> Int)
-> ((Pair, Pair) -> Int)
-> Ix Pair
(Pair, Pair) -> Int
(Pair, Pair) -> [Pair]
(Pair, Pair) -> Pair -> Bool
(Pair, Pair) -> Pair -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (Pair, Pair) -> [Pair]
range :: (Pair, Pair) -> [Pair]
$cindex :: (Pair, Pair) -> Pair -> Int
index :: (Pair, Pair) -> Pair -> Int
$cunsafeIndex :: (Pair, Pair) -> Pair -> Int
unsafeIndex :: (Pair, Pair) -> Pair -> Int
$cinRange :: (Pair, Pair) -> Pair -> Bool
inRange :: (Pair, Pair) -> Pair -> Bool
$crangeSize :: (Pair, Pair) -> Int
rangeSize :: (Pair, Pair) -> Int
$cunsafeRangeSize :: (Pair, Pair) -> Int
unsafeRangeSize :: (Pair, Pair) -> Int
Ix, Int -> Pair -> String -> String
[Pair] -> String -> String
Pair -> String
(Int -> Pair -> String -> String)
-> (Pair -> String) -> ([Pair] -> String -> String) -> Show Pair
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Pair -> String -> String
showsPrec :: Int -> Pair -> String -> String
$cshow :: Pair -> String
show :: Pair -> String
$cshowList :: [Pair] -> String -> String
showList :: [Pair] -> String -> String
Show)

-- | Defines the maximum number of color-pairs the terminal can support).
colorPairs :: IO Int
colorPairs :: IO Int
colorPairs = (Signal -> Int) -> IO Signal -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Signal -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Signal -> IO Int) -> IO Signal -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr Signal -> IO Signal
forall a. Storable a => Ptr a -> IO a
peek Ptr Signal
colorPairsPtr

foreign import ccall "HSCurses.h &COLOR_PAIRS"
    colorPairsPtr :: Ptr CInt

newtype Color = Color Int deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq, Eq Color
Eq Color =>
(Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Color -> Color -> Ordering
compare :: Color -> Color -> Ordering
$c< :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
>= :: Color -> Color -> Bool
$cmax :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
min :: Color -> Color -> Color
Ord, Ord Color
Ord Color =>
((Color, Color) -> [Color])
-> ((Color, Color) -> Color -> Int)
-> ((Color, Color) -> Color -> Int)
-> ((Color, Color) -> Color -> Bool)
-> ((Color, Color) -> Int)
-> ((Color, Color) -> Int)
-> Ix Color
(Color, Color) -> Int
(Color, Color) -> [Color]
(Color, Color) -> Color -> Bool
(Color, Color) -> Color -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (Color, Color) -> [Color]
range :: (Color, Color) -> [Color]
$cindex :: (Color, Color) -> Color -> Int
index :: (Color, Color) -> Color -> Int
$cunsafeIndex :: (Color, Color) -> Color -> Int
unsafeIndex :: (Color, Color) -> Color -> Int
$cinRange :: (Color, Color) -> Color -> Bool
inRange :: (Color, Color) -> Color -> Bool
$crangeSize :: (Color, Color) -> Int
rangeSize :: (Color, Color) -> Int
$cunsafeRangeSize :: (Color, Color) -> Int
unsafeRangeSize :: (Color, Color) -> Int
Ix)

colors :: IO Int
colors :: IO Int
colors = (Signal -> Int) -> IO Signal -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Signal -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Signal -> IO Int) -> IO Signal -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr Signal -> IO Signal
forall a. Storable a => Ptr a -> IO a
peek Ptr Signal
colorsPtr

foreign import ccall "HSCurses.h &COLORS" colorsPtr :: Ptr CInt

color :: String -> Maybe Color
color :: String -> Maybe Color
color String
"default" = Color -> Maybe Color
forall a. a -> Maybe a
Just (Color -> Maybe Color) -> Color -> Maybe Color
forall a b. (a -> b) -> a -> b
$ Int -> Color
Color (-Int
1)
color String
"black" = Color -> Maybe Color
forall a. a -> Maybe a
Just (Color -> Maybe Color) -> Color -> Maybe Color
forall a b. (a -> b) -> a -> b
$ Int -> Color
Color (Int
0)
{-# LINE 630 "UI/HSCurses/Curses.hsc" #-}
color "red" = Just $ Color (1)
{-# LINE 631 "UI/HSCurses/Curses.hsc" #-}
color "green" = Just $ Color (2)
{-# LINE 632 "UI/HSCurses/Curses.hsc" #-}
color "yellow" = Just $ Color (3)
{-# LINE 633 "UI/HSCurses/Curses.hsc" #-}
color "blue" = Just $ Color (4)
{-# LINE 634 "UI/HSCurses/Curses.hsc" #-}
color "magenta" = Just $ Color (5)
{-# LINE 635 "UI/HSCurses/Curses.hsc" #-}
color "cyan" = Just $ Color (6)
{-# LINE 636 "UI/HSCurses/Curses.hsc" #-}
color "white" = Just $ Color (7)
{-# LINE 637 "UI/HSCurses/Curses.hsc" #-}
color _ = Nothing

-- | 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 -> Color -> Color -> IO ()
initPair (Pair Int
p) (Color Int
f) (Color Int
b) =
    String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"init_pair" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$
        CShort -> CShort -> CShort -> IO Signal
init_pair (Int -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p) (Int -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
f) (Int -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b)

foreign import ccall unsafe
    init_pair :: CShort -> CShort -> CShort -> IO CInt

pairContent :: Pair -> IO (Color, Color)
pairContent :: Pair -> IO (Color, Color)
pairContent (Pair Int
p) =
    (Ptr CShort -> IO (Color, Color)) -> IO (Color, Color)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CShort -> IO (Color, Color)) -> IO (Color, Color))
-> (Ptr CShort -> IO (Color, Color)) -> IO (Color, Color)
forall a b. (a -> b) -> a -> b
$ \Ptr CShort
fPtr ->
        (Ptr CShort -> IO (Color, Color)) -> IO (Color, Color)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CShort -> IO (Color, Color)) -> IO (Color, Color))
-> (Ptr CShort -> IO (Color, Color)) -> IO (Color, Color)
forall a b. (a -> b) -> a -> b
$ \Ptr CShort
bPtr -> do
            String -> IO Signal -> IO Signal
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO a
throwIfErr String
"pair_content" (IO Signal -> IO Signal) -> IO Signal -> IO Signal
forall a b. (a -> b) -> a -> b
$ CShort -> Ptr CShort -> Ptr CShort -> IO Signal
pair_content (Int -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p) Ptr CShort
fPtr Ptr CShort
bPtr
            f <- Ptr CShort -> IO CShort
forall a. Storable a => Ptr a -> IO a
peek Ptr CShort
fPtr
            b <- peek bPtr
            return (Color (fromIntegral f), Color (fromIntegral b))

foreign import ccall unsafe
    pair_content :: CShort -> Ptr CShort -> Ptr CShort -> IO CInt

canChangeColor :: IO Bool
canChangeColor :: IO Bool
canChangeColor = (NBool -> Bool) -> IO NBool -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (NBool -> NBool -> Bool
forall a. Eq a => a -> a -> Bool
/= NBool
0) IO NBool
can_change_color

foreign import ccall unsafe can_change_color :: IO (Word8)
{-# LINE 683 "UI/HSCurses/Curses.hsc" #-}

initColor :: Color -> (Int, Int, Int) -> IO ()
initColor :: Color -> (Int, Int, Int) -> IO ()
initColor (Color Int
c) (Int
r, Int
g, Int
b) =
    String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"init_color" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$
        CShort -> CShort -> CShort -> CShort -> IO Signal
init_color (Int -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c) (Int -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r) (Int -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g) (Int -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b)

foreign import ccall unsafe
    init_color :: CShort -> CShort -> CShort -> CShort -> IO CInt

colorContent :: Color -> IO (Int, Int, Int)
colorContent :: Color -> IO (Int, Int, Int)
colorContent (Color Int
c) =
    (Ptr CShort -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CShort -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr CShort -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CShort
rPtr ->
        (Ptr CShort -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CShort -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr CShort -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CShort
gPtr ->
            (Ptr CShort -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CShort -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr CShort -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CShort
bPtr -> do
                String -> IO Signal -> IO Signal
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO a
throwIfErr String
"color_content" (IO Signal -> IO Signal) -> IO Signal -> IO Signal
forall a b. (a -> b) -> a -> b
$ CShort -> Ptr CShort -> Ptr CShort -> Ptr CShort -> IO Signal
color_content (Int -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c) Ptr CShort
rPtr Ptr CShort
gPtr Ptr CShort
bPtr
                r <- Ptr CShort -> IO CShort
forall a. Storable a => Ptr a -> IO a
peek Ptr CShort
rPtr
                g <- peek gPtr
                b <- peek bPtr
                return (fromIntegral r, fromIntegral g, fromIntegral b)

foreign import ccall unsafe
    color_content :: CShort -> Ptr CShort -> Ptr CShort -> Ptr CShort -> IO CInt

foreign import ccall unsafe "HSCurses.h hs_curses_color_pair" colorPair :: Pair -> ChType

-----------------------------------------------------------------------------
-- * Attributes
-----------------------------------------------------------------------------

foreign import ccall unsafe "HSCurses.h attr_set"
    attr_set :: Attr -> CShort -> Ptr a -> IO Int

foreign import ccall unsafe "HSCurses.h wattr_set"
    wattr_set :: Window -> Attr -> CInt -> Ptr a -> IO CInt

foreign import ccall unsafe "HSCurses.h wattr_get"
    wattr_get :: Window -> Ptr Attr -> Ptr CShort -> Ptr a -> IO CInt

foreign import ccall "HSCurses.h attr_on" attr_on :: (Word32) -> Ptr a -> IO Int
{-# LINE 722 "UI/HSCurses/Curses.hsc" #-}
foreign import ccall "HSCurses.h attr_off" attr_off :: (Word32) -> Ptr a -> IO Int
{-# LINE 723 "UI/HSCurses/Curses.hsc" #-}
foreign import ccall "HSCurses.h attron" attron :: Int -> IO Int
foreign import ccall "HSCurses.h attroff" attroff :: Int -> IO Int
foreign import ccall unsafe "HSCurses.h wattron" wattron :: Window -> CInt -> IO CInt
foreign import ccall unsafe "HSCurses.h wattroff" wattroff :: Window -> CInt -> IO CInt
foreign import ccall standout :: IO Int
foreign import ccall standend :: IO Int

wAttrSet :: Window -> (Attr, Pair) -> IO ()
wAttrSet :: Window -> (Attr, Pair) -> IO ()
wAttrSet Window
w (Attr
a, (Pair Int
p)) =
    String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"wattr_set" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$
        Window -> Attr -> Signal -> Ptr Any -> IO Signal
forall a. Window -> Attr -> Signal -> Ptr a -> IO Signal
wattr_set Window
w Attr
a (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p) Ptr Any
forall a. Ptr a
nullPtr

-- | Manipulate the current attributes of the named window. see curs_attr(3)
wAttrGet :: Window -> IO (Attr, Pair)
wAttrGet :: Window -> IO (Attr, Pair)
wAttrGet Window
w =
    (Ptr Attr -> IO (Attr, Pair)) -> IO (Attr, Pair)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Attr -> IO (Attr, Pair)) -> IO (Attr, Pair))
-> (Ptr Attr -> IO (Attr, Pair)) -> IO (Attr, Pair)
forall a b. (a -> b) -> a -> b
$ \Ptr Attr
pa ->
        (Ptr CShort -> IO (Attr, Pair)) -> IO (Attr, Pair)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CShort -> IO (Attr, Pair)) -> IO (Attr, Pair))
-> (Ptr CShort -> IO (Attr, Pair)) -> IO (Attr, Pair)
forall a b. (a -> b) -> a -> b
$ \Ptr CShort
pp -> do
            String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"wattr_get" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Ptr Attr -> Ptr CShort -> Ptr Any -> IO Signal
forall a. Window -> Ptr Attr -> Ptr CShort -> Ptr a -> IO Signal
wattr_get Window
w Ptr Attr
pa Ptr CShort
pp Ptr Any
forall a. Ptr a
nullPtr
            a <- Ptr Attr -> IO Attr
forall a. Storable a => Ptr a -> IO a
peek Ptr Attr
pa
            p <- peek pp
            return (a, Pair $ fromIntegral p)

newtype Attr = Attr (Word32)
{-# LINE 746 "UI/HSCurses/Curses.hsc" #-}
    deriving (Eq, Storable, Bits, Num, Show)

-- | Normal display (no highlight)
attr0 :: Attr

{-# LINE 751 "UI/HSCurses/Curses.hsc" #-}
attr0 = Attr (0)
{-# LINE 752 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 755 "UI/HSCurses/Curses.hsc" #-}

isAltCharset, isBlink, isBold, isDim, isHorizontal, isInvis, isLeft,
    isLow, isProtect, isReverse, isRight, isStandout, isTop,
    isUnderline, isVertical :: Attr -> Bool

isAltCharset :: Attr -> Bool
isAltCharset = Word32 -> Attr -> Bool
isAttr (Word32
4194304)
{-# LINE 761 "UI/HSCurses/Curses.hsc" #-}
isBlink      = isAttr (524288)
{-# LINE 762 "UI/HSCurses/Curses.hsc" #-}
isBold       = isAttr (2097152)
{-# LINE 763 "UI/HSCurses/Curses.hsc" #-}
isDim        = isAttr (1048576)
{-# LINE 764 "UI/HSCurses/Curses.hsc" #-}
isHorizontal = isAttr (33554432)
{-# LINE 765 "UI/HSCurses/Curses.hsc" #-}
isInvis      = isAttr (8388608)
{-# LINE 766 "UI/HSCurses/Curses.hsc" #-}
isLeft       = isAttr (67108864)
{-# LINE 767 "UI/HSCurses/Curses.hsc" #-}
isLow        = isAttr (134217728)
{-# LINE 768 "UI/HSCurses/Curses.hsc" #-}
isProtect    = isAttr (16777216)
{-# LINE 769 "UI/HSCurses/Curses.hsc" #-}
isReverse    = isAttr (262144)
{-# LINE 770 "UI/HSCurses/Curses.hsc" #-}
isRight      = isAttr (268435456)
{-# LINE 771 "UI/HSCurses/Curses.hsc" #-}
isStandout   = isAttr (65536)
{-# LINE 772 "UI/HSCurses/Curses.hsc" #-}
isTop        = isAttr (536870912)
{-# LINE 773 "UI/HSCurses/Curses.hsc" #-}
isUnderline  = isAttr (131072)
{-# LINE 774 "UI/HSCurses/Curses.hsc" #-}
isVertical   = isAttr (1073741824)
{-# LINE 775 "UI/HSCurses/Curses.hsc" #-}

isAttr :: (Word32) -> Attr -> Bool
{-# LINE 777 "UI/HSCurses/Curses.hsc" #-}
isAttr b (Attr a) = a .&. b /= 0

setAltCharset, setBlink, setBold, setDim, setHorizontal, setInvis,
    setLeft, setLow, setProtect, setReverse, setRight, setStandout,
    setTop, setUnderline, setVertical :: Attr -> Bool -> Attr

setAltCharset :: Attr -> Bool -> Attr
setAltCharset = Word32 -> Attr -> Bool -> Attr
setAttr (Word32
4194304)
setBlink :: Attr -> Bool -> Attr
{-# LINE 784 "UI/HSCurses/Curses.hsc" #-}
setBlink      = setAttr (524288)
{-# LINE 785 "UI/HSCurses/Curses.hsc" #-}
setBold       = setAttr (2097152)
{-# LINE 786 "UI/HSCurses/Curses.hsc" #-}
setDim        = setAttr (1048576)
{-# LINE 787 "UI/HSCurses/Curses.hsc" #-}
setHorizontal = setAttr (33554432)
setInvis :: Attr -> Bool -> Attr
{-# LINE 788 "UI/HSCurses/Curses.hsc" #-}
setInvis      = setAttr (8388608)
{-# LINE 789 "UI/HSCurses/Curses.hsc" #-}
setLeft       = setAttr (67108864)
{-# LINE 790 "UI/HSCurses/Curses.hsc" #-}
setLow        = setAttr (134217728)
{-# LINE 791 "UI/HSCurses/Curses.hsc" #-}
setProtect    = setAttr (16777216)
{-# LINE 792 "UI/HSCurses/Curses.hsc" #-}
setReverse    = setAttr (262144)
setRight :: Attr -> Bool -> Attr
{-# LINE 793 "UI/HSCurses/Curses.hsc" #-}
setRight      = setAttr (268435456)
{-# LINE 794 "UI/HSCurses/Curses.hsc" #-}
setStandout   = setAttr (65536)
{-# LINE 795 "UI/HSCurses/Curses.hsc" #-}
setTop        = setAttr (536870912)
{-# LINE 796 "UI/HSCurses/Curses.hsc" #-}
setUnderline  = setAttr (131072)
{-# LINE 797 "UI/HSCurses/Curses.hsc" #-}
setVertical   = setAttr (1073741824)
{-# LINE 798 "UI/HSCurses/Curses.hsc" #-}

setAttr :: (Word32) -> Attr -> Bool -> Attr
{-# LINE 800 "UI/HSCurses/Curses.hsc" #-}
setAttr b (Attr a) False = Attr (a .&. complement b)
setAttr b (Attr a) True  = Attr (a .|. b)

attrPlus :: Attr -> Attr -> Attr
attrPlus :: Attr -> Attr -> Attr
attrPlus (Attr Word32
a) (Attr Word32
b) = Word32 -> Attr
Attr (Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
b)

attrSet :: Attr -> Pair -> IO ()
attrSet :: Attr -> Pair -> IO ()
attrSet Attr
attr (Pair Int
p) = String -> IO Int -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"attrset" (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$
    Attr -> CShort -> Ptr Any -> IO Int
forall a. Attr -> CShort -> Ptr a -> IO Int
attr_set Attr
attr (Int -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p) Ptr Any
forall a. Ptr a
nullPtr

attrOn :: Attr -> IO ()
attrOn :: Attr -> IO ()
attrOn (Attr Word32
attr) = String -> IO Int -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"attr_on" (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$
    Word32 -> Ptr Any -> IO Int
forall a. Word32 -> Ptr a -> IO Int
attr_on Word32
attr Ptr Any
forall a. Ptr a
nullPtr

attrOff :: Attr -> IO ()
attrOff :: Attr -> IO ()
attrOff (Attr Word32
attr) = String -> IO Int -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"attr_off" (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$
    Word32 -> Ptr Any -> IO Int
forall a. Word32 -> Ptr a -> IO Int
attr_off Word32
attr Ptr Any
forall a. Ptr a
nullPtr

wAttrOn :: Window -> Int -> IO ()
wAttrOn :: Window -> Int -> IO ()
wAttrOn Window
w Int
x = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"wattron" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Signal -> IO Signal
wattron Window
w (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fi Int
x)

wAttrOff :: Window -> Int -> IO ()
wAttrOff :: Window -> Int -> IO ()
wAttrOff Window
w Int
x = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"wattroff" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Signal -> IO Signal
wattroff Window
w (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fi Int
x)

attrDimOn :: IO ()
attrDimOn :: IO ()
attrDimOn  = String -> IO Int -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"attron A_DIM" (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$
    Int -> IO Int
attron (Int
1048576)
{-# LINE 827 "UI/HSCurses/Curses.hsc" #-}

attrDimOff :: IO ()
attrDimOff :: IO ()
attrDimOff = String -> IO Int -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"attroff A_DIM" (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$
    Int -> IO Int
attroff (Int
1048576)
{-# LINE 831 "UI/HSCurses/Curses.hsc" #-}

attrBoldOn :: IO ()
attrBoldOn :: IO ()
attrBoldOn  = String -> IO Int -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"attron A_BOLD" (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$
    Int -> IO Int
attron (Int
2097152)
{-# LINE 835 "UI/HSCurses/Curses.hsc" #-}

attrBoldOff :: IO ()
attrBoldOff :: IO ()
attrBoldOff = String -> IO Int -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"attroff A_BOLD" (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$
    Int -> IO Int
attroff (Int
2097152)
{-# LINE 839 "UI/HSCurses/Curses.hsc" #-}

attrDim :: Int
attrDim :: Int
attrDim = (Int
1048576)
{-# LINE 842 "UI/HSCurses/Curses.hsc" #-}
attrBold :: Int
attrBold :: Int
attrBold = (Int
2097152)
{-# LINE 844 "UI/HSCurses/Curses.hsc" #-}

-- | Raw NCurses routine.
foreign import ccall safe
    waddch :: Window -> ChType -> IO CInt

-- | Raw NCurses routine.
foreign import ccall safe
    winsch :: Window -> ChType -> IO CInt

-- | Raw NCurses routine.
foreign import ccall safe
    waddchnstr :: Window -> CString -> CInt -> IO CInt

foreign import ccall safe "static curses.h mvaddch"
    mvaddch_c :: CInt -> CInt -> ChType -> IO ()

mvWAddStr :: Window -> Int -> Int -> String -> IO ()
mvWAddStr :: Window -> Int -> Int -> String -> IO ()
mvWAddStr Window
w Int
y Int
x String
str = Window -> Int -> Int -> IO ()
wMove Window
w Int
y Int
x IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> String -> IO ()
wAddStr Window
w String
str

mvAddCh :: Int -> Int -> ChType -> IO ()
mvAddCh :: Int -> Int -> Word32 -> IO ()
mvAddCh Int
l Int
m Word32
n = Signal -> Signal -> Word32 -> IO ()
mvaddch_c (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)

addLn :: IO ()
addLn :: IO ()
addLn = Window -> String -> IO ()
wAddStr Window
stdScr String
"\n"


{-# LINE 870 "UI/HSCurses/Curses.hsc" #-}

foreign import ccall unsafe
    waddnwstr :: Window -> CWString -> CInt -> IO CInt

wAddStr :: Window -> String -> IO ()
wAddStr :: Window -> String -> IO ()
wAddStr Window
win String
str = do
    let convStr :: ([a] -> String) -> IO ()
convStr [a] -> String
f = case [a] -> String
f [] of
            [] -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            String
s ->
                String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"waddnstr" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$
                    String -> (CWStringLen -> IO Signal) -> IO Signal
forall a. String -> (CWStringLen -> IO a) -> IO a
withCWStringLen (String
s) (\(Ptr CWchar
ws, Int
len) -> (Window -> Ptr CWchar -> Signal -> IO Signal
waddnwstr Window
win Ptr CWchar
ws (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fi Int
len)))
        loop :: String -> (String -> String) -> IO ()
loop [] String -> String
acc = (String -> String) -> IO ()
forall {a}. ([a] -> String) -> IO ()
convStr String -> String
acc
        loop (Char
ch : String
str') String -> String
acc =
            Char -> IO () -> (Word32 -> IO ()) -> IO ()
forall a. Char -> IO a -> (Word32 -> IO a) -> IO a
recognize
                Char
ch
                (String -> (String -> String) -> IO ()
loop String
str' (String -> String
acc (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
ch Char -> String -> String
forall a. a -> [a] -> [a]
:)))
                ( \Word32
ch' -> do
                    (String -> String) -> IO ()
forall {a}. ([a] -> String) -> IO ()
convStr String -> String
acc
                    String -> IO Signal -> IO Signal
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO a
throwIfErr String
"waddch" (IO Signal -> IO Signal) -> IO Signal -> IO Signal
forall a b. (a -> b) -> a -> b
$ Window -> Word32 -> IO Signal
waddch Window
win Word32
ch'
                    String -> (String -> String) -> IO ()
loop String
str' String -> String
forall a. a -> a
id
                )
    String -> (String -> String) -> IO ()
loop String
str String -> String
forall a. a -> a
id


{-# LINE 915 "UI/HSCurses/Curses.hsc" #-}

foreign import ccall safe
    vline :: Char -> Int -> IO ()

--
-- what ?
--



bkgrndSet :: Attr -> Pair -> IO ()
bkgrndSet :: Attr -> Pair -> IO ()
bkgrndSet (Attr Word32
a) Pair
p = Word32 -> IO ()
bkgdset (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$
    Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
' ') Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
    (if Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
4194304 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 then Word32
4194304 else Word32
0) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
{-# LINE 931 "UI/HSCurses/Curses.hsc" #-}
    (if Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
524288 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 then Word32
524288 else Word32
0) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
{-# LINE 932 "UI/HSCurses/Curses.hsc" #-}
    (if a .&. 2097152 /= 0 then 2097152 else 0) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
{-# LINE 933 "UI/HSCurses/Curses.hsc" #-}
    (if a .&. 1048576 /= 0 then 1048576 else 0) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
{-# LINE 934 "UI/HSCurses/Curses.hsc" #-}
    (if a .&. 8388608 /= 0 then 8388608 else 0) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
{-# LINE 935 "UI/HSCurses/Curses.hsc" #-}
    (if a .&. 16777216 /= 0 then 16777216 else 0) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
{-# LINE 936 "UI/HSCurses/Curses.hsc" #-}
    (if a .&. 262144 /= 0 then 262144 else 0) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
{-# LINE 937 "UI/HSCurses/Curses.hsc" #-}
    (if a .&. 65536 /= 0 then 65536 else 0) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
{-# LINE 938 "UI/HSCurses/Curses.hsc" #-}
    (if a .&. 131072 /= 0 then 131072 else 0) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
{-# LINE 939 "UI/HSCurses/Curses.hsc" #-}
    colorPair p

foreign import ccall unsafe bkgdset :: ChType -> IO ()

-- | Copy blanks to every position in the screen.
erase :: IO ()
erase :: IO ()
erase = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"erase" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> IO Signal
werase_c Window
stdScr

foreign import ccall unsafe "werase" werase_c :: Window -> IO CInt

-- | Copy blanks to every position in a window.
werase :: Window -> IO ()
werase :: Window -> IO ()
werase Window
w = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"werase" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> IO Signal
werase_c Window
w

-- | Copy blanks to a window and set clearOk for that window.
wclear :: Window -> IO ()
wclear :: Window -> IO ()
wclear Window
w = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"wclear" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> IO Signal
wclear_c Window
w

foreign import ccall unsafe "wclear" wclear_c :: Window -> IO CInt

clrToEol :: IO ()
clrToEol :: IO ()
clrToEol = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"clrtoeol" IO Signal
clrtoeol

foreign import ccall unsafe 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).
--
-- Note that 'move_c' may be a macro.
move :: Int -> Int -> IO ()
move :: Int -> Int -> IO ()
move Int
y Int
x = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"move" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Signal -> Signal -> IO Signal
move_c (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)

foreign import ccall unsafe "move"
    move_c :: CInt -> CInt -> 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 :: Window -> Int -> Int -> IO ()
wMove Window
w Int
y Int
x = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"wmove" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Signal -> Signal -> IO Signal
wmove Window
w (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fi Int
y) (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fi Int
x)

foreign import ccall unsafe
    wmove :: Window -> CInt -> CInt -> IO CInt

-----------------------------------------------------------------------------
-- * Cursor routines
-----------------------------------------------------------------------------

data CursorVisibility
    = CursorInvisible
    | CursorVisible
    | CursorVeryVisible

vis_c :: CursorVisibility -> CInt
vis_c :: CursorVisibility -> Signal
vis_c CursorVisibility
vis = case CursorVisibility
vis of
    CursorVisibility
CursorInvisible -> Signal
0
    CursorVisibility
CursorVisible -> Signal
1
    CursorVisibility
CursorVeryVisible -> Signal
2

c_vis :: CInt -> CursorVisibility
c_vis :: Signal -> CursorVisibility
c_vis Signal
0 = CursorVisibility
CursorInvisible
c_vis Signal
1 = CursorVisibility
CursorVisible
c_vis Signal
2 = CursorVisibility
CursorVeryVisible
c_vis Signal
n = String -> CursorVisibility
forall a. HasCallStack => String -> a
error (String
"Illegal C value for cursor visibility: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Signal -> String
forall a. Show a => a -> String
show Signal
n)

-- | 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 :: CursorVisibility -> IO CursorVisibility
cursSet :: CursorVisibility -> IO CursorVisibility
cursSet CursorVisibility
CursorInvisible = do
    Bool -> IO Signal
leaveOk Bool
True
    old <- Signal -> IO Signal
curs_set Signal
0
    return $ c_vis old
cursSet CursorVisibility
v = do
    Bool -> IO Signal
leaveOk Bool
False
    old <- Signal -> IO Signal
curs_set (CursorVisibility -> Signal
vis_c CursorVisibility
v)
    return $ c_vis old

foreign import ccall unsafe "HSCurses.h curs_set"
    curs_set :: CInt -> IO CInt

-- | Get the current cursor coordinates.
getYX :: Window -> IO (Int, Int)
getYX :: Window -> IO (Int, Int)
getYX Window
w =
    (Ptr Signal -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Signal -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr Signal -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Signal
py ->
        -- allocate two ints on the stack
        (Ptr Signal -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Signal -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr Signal -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Signal
px -> do
            Window -> Ptr Signal -> Ptr Signal -> IO ()
nomacro_getyx Window
w Ptr Signal
py Ptr Signal
px -- writes current cursor coords
            y <- Ptr Signal -> IO Signal
forall a. Storable a => Ptr a -> IO a
peek Ptr Signal
py
            x <- peek px
            return (fromIntegral y, fromIntegral 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.
foreign import ccall unsafe "HSCursesUtils.h hscurses_nomacro_getyx"
    nomacro_getyx :: Window -> Ptr CInt -> Ptr CInt -> IO ()

touchWin :: Window -> IO ()
touchWin :: Window -> IO ()
touchWin Window
w = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"touchwin" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> IO Signal
touchwin Window
w

foreign import ccall touchwin :: Window -> IO CInt

newPad :: Int -> Int -> IO Window
newPad :: Int -> Int -> IO Window
newPad Int
nlines Int
ncols =
    String -> IO Window -> IO Window
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull String
"newpad" (IO Window -> IO Window) -> IO Window -> IO Window
forall a b. (a -> b) -> a -> b
$
        Signal -> Signal -> IO Window
newpad (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nlines) (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ncols)

pRefresh :: Window -> Int -> Int -> Int -> Int -> Int -> Int -> IO ()
pRefresh :: Window -> Int -> Int -> Int -> Int -> Int -> Int -> IO ()
pRefresh Window
pad Int
pminrow Int
pmincol Int
sminrow Int
smincol Int
smaxrow Int
smaxcol =
    String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"prefresh" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$
        Window
-> Signal
-> Signal
-> Signal
-> Signal
-> Signal
-> Signal
-> IO Signal
prefresh
            Window
pad
            (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pminrow)
            (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pmincol)
            (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sminrow)
            (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
smincol)
            (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
smaxrow)
            (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
smaxcol)

delWin :: Window -> IO ()
delWin :: Window -> IO ()
delWin Window
w = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"delwin" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> IO Signal
delwin Window
w

data Border = Border
    { Border -> Char
ls :: Char
    , Border -> Char
rs :: Char
    , Border -> Char
ts :: Char
    , Border -> Char
bs :: Char
    , Border -> Char
tl :: Char
    , Border -> Char
tr :: Char
    , Border -> Char
bl :: Char
    , Border -> Char
br :: Char
    }

defaultBorder :: Border
defaultBorder :: Border
defaultBorder = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Border
Border Char
'\0' Char
'\0' Char
'\0' Char
'\0' Char
'\0' Char
'\0' Char
'\0' Char
'\0'

-- | Draw a border around the edges of a window. 'defaultBorder' is a record
-- representing all 0 parameters to wrecord.
wBorder :: Window -> Border -> IO ()
wBorder :: Window -> Border -> IO ()
wBorder Window
w (Border Char
ls Char
rs Char
ts Char
bs Char
tl Char
tr Char
bl Char
br) =
    String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"wborder" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$
        Window
-> CChar
-> CChar
-> CChar
-> CChar
-> CChar
-> CChar
-> CChar
-> CChar
-> IO Signal
wborder Window
w CChar
ls' CChar
rs' CChar
ts' CChar
bs' CChar
tl' CChar
tr' CChar
bl' CChar
br'
  where
    ls' :: CChar
ls' = Char -> CChar
castCharToCChar Char
ls
    rs' :: CChar
rs' = Char -> CChar
castCharToCChar Char
rs
    ts' :: CChar
ts' = Char -> CChar
castCharToCChar Char
ts
    bs' :: CChar
bs' = Char -> CChar
castCharToCChar Char
bs
    tl' :: CChar
tl' = Char -> CChar
castCharToCChar Char
tl
    tr' :: CChar
tr' = Char -> CChar
castCharToCChar Char
tr
    bl' :: CChar
bl' = Char -> CChar
castCharToCChar Char
bl
    br' :: CChar
br' = Char -> CChar
castCharToCChar Char
br

foreign import ccall unsafe
    prefresh :: Window -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt

foreign import ccall unsafe
    newpad :: CInt -> CInt -> IO Window

foreign import ccall unsafe
    delwin :: Window -> IO CInt

foreign import ccall unsafe
    wborder :: Window -> CChar -> CChar -> CChar -> CChar -> CChar -> CChar -> CChar -> CChar -> IO CInt

newWin :: Int -> Int -> Int -> Int -> IO Window
newWin :: Int -> Int -> Int -> Int -> IO Window
newWin Int
nlines Int
ncolumn Int
begin_y Int
begin_x =
    String -> IO Window -> IO Window
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull String
"newwin" (IO Window -> IO Window) -> IO Window -> IO Window
forall a b. (a -> b) -> a -> b
$
        Signal -> Signal -> Signal -> Signal -> IO Window
newwin (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fi Int
nlines) (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fi Int
ncolumn) (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fi Int
begin_y) (Int -> Signal
forall a b. (Integral a, Num b) => a -> b
fi Int
begin_x)

foreign import ccall unsafe
    newwin :: CInt -> CInt -> CInt -> CInt -> IO Window

wClrToEol :: Window -> IO ()
wClrToEol :: Window -> IO ()
wClrToEol Window
w = String -> IO Signal -> IO ()
forall a. (Eq a, Show a, Num a) => String -> IO a -> IO ()
throwIfErr_ String
"wclrtoeol" (IO Signal -> IO ()) -> IO Signal -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> IO Signal
wclrtoeol Window
w

foreign import ccall unsafe wclrtoeol :: Window -> IO CInt

-- | >      The getch, wgetch, mvgetch and mvwgetch, routines read a
--   >      character  from the window.

{-# LINE 1130 "UI/HSCurses/Curses.hsc" #-}
foreign import ccall unsafe "HSCurses.h getch" getch :: IO CInt

{-# LINE 1132 "UI/HSCurses/Curses.hsc" #-}

foreign import ccall unsafe flushinp :: IO CInt

foreign import ccall unsafe "HSCurses.h noqiflush" noqiflush :: IO ()

foreign import ccall unsafe "HSCurses.h beep" c_beep :: IO CInt
foreign import ccall unsafe "HSCurses.h flash" c_flash :: IO CInt

beep :: IO ()
beep :: IO ()
beep = do
    br <- IO Signal
c_beep
    when (br /= (0)) (c_flash >> return ())
{-# LINE 1144 "UI/HSCurses/Curses.hsc" #-}

-- | A mapping of curses keys to Haskell values.
data Key
    = KeyChar Char
    | KeyBreak
    | KeyDown
    | KeyUp
    | KeyLeft
    | KeyRight
    | KeyHome
    | KeyBackspace
    | KeyF Int
    | KeyDL
    | KeyIL
    | KeyDC
    | KeyIC
    | KeyEIC
    | KeyClear
    | KeyEOS
    | KeyEOL
    | KeySF
    | KeySR
    | KeyNPage
    | KeyPPage
    | KeySTab
    | KeyCTab
    | KeyCATab
    | KeyEnter
    | KeySReset
    | KeyReset
    | KeyPrint
    | KeyLL
    | KeyA1
    | KeyA3
    | KeyB2
    | KeyC1
    | KeyC3
    | KeyBTab
    | KeyBeg
    | KeyCancel
    | KeyClose
    | KeyCommand
    | KeyCopy
    | KeyCreate
    | KeyEnd
    | KeyExit
    | KeyFind
    | KeyHelp
    | KeyMark
    | KeyMessage
    | KeyMove
    | KeyNext
    | KeyOpen
    | KeyOptions
    | KeyPrevious
    | KeyRedo
    | KeyReference
    | KeyRefresh
    | KeyReplace
    | KeyRestart
    | KeyResume
    | KeySave
    | KeySBeg
    | KeySCancel
    | KeySCommand
    | KeySCopy
    | KeySCreate
    | KeySDC
    | KeySDL
    | KeySelect
    | KeySEnd
    | KeySEOL
    | KeySExit
    | KeySFind
    | KeySHelp
    | KeySHome
    | KeySIC
    | KeySLeft
    | KeySMessage
    | KeySMove
    | KeySNext
    | KeySOptions
    | KeySPrevious
    | KeySPrint
    | KeySRedo
    | KeySReplace
    | KeySRight
    | KeySRsume
    | KeySSave
    | KeySSuspend
    | KeySUndo
    | KeySuspend
    | KeyUndo
    | KeyResize
    | KeyMouse
    | KeyUnknown Int
    deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq, Int -> Key -> String -> String
[Key] -> String -> String
Key -> String
(Int -> Key -> String -> String)
-> (Key -> String) -> ([Key] -> String -> String) -> Show Key
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Key -> String -> String
showsPrec :: Int -> Key -> String -> String
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> String -> String
showList :: [Key] -> String -> String
Show)

decodeKey :: CInt -> Key
decodeKey :: Signal -> Key
decodeKey Signal
key = case Signal
key of
    Signal
_ | Signal
key Signal -> Signal -> Bool
forall a. Ord a => a -> a -> Bool
>= Signal
0 Bool -> Bool -> Bool
&& Signal
key Signal -> Signal -> Bool
forall a. Ord a => a -> a -> Bool
<= Signal
255 -> Char -> Key
KeyChar (Int -> Char
chr (Signal -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Signal
key))
    (Signal
257)         -> Key
KeyBreak
{-# LINE 1246 "UI/HSCurses/Curses.hsc" #-}
    (258)          -> KeyDown
{-# LINE 1247 "UI/HSCurses/Curses.hsc" #-}
    (259)            -> KeyUp
{-# LINE 1248 "UI/HSCurses/Curses.hsc" #-}
    (260)          -> KeyLeft
{-# LINE 1249 "UI/HSCurses/Curses.hsc" #-}
    (261)         -> KeyRight
{-# LINE 1250 "UI/HSCurses/Curses.hsc" #-}
    (262)          -> KeyHome
{-# LINE 1251 "UI/HSCurses/Curses.hsc" #-}
    (263)     -> KeyBackspace
{-# LINE 1252 "UI/HSCurses/Curses.hsc" #-}
    _ | key >= (264) && key <= (327)
{-# LINE 1253 "UI/HSCurses/Curses.hsc" #-}
                               -> KeyF (fromIntegral (key - 264))
{-# LINE 1254 "UI/HSCurses/Curses.hsc" #-}
    (328)            -> KeyDL
{-# LINE 1255 "UI/HSCurses/Curses.hsc" #-}
    (329)            -> KeyIL
{-# LINE 1256 "UI/HSCurses/Curses.hsc" #-}
    (330)            -> KeyDC
{-# LINE 1257 "UI/HSCurses/Curses.hsc" #-}
    (331)            -> KeyIC
{-# LINE 1258 "UI/HSCurses/Curses.hsc" #-}
    (332)           -> KeyEIC
{-# LINE 1259 "UI/HSCurses/Curses.hsc" #-}
    (333)         -> KeyClear
{-# LINE 1260 "UI/HSCurses/Curses.hsc" #-}
    (334)           -> KeyEOS
{-# LINE 1261 "UI/HSCurses/Curses.hsc" #-}
    (335)           -> KeyEOL
{-# LINE 1262 "UI/HSCurses/Curses.hsc" #-}
    (336)            -> KeySF
{-# LINE 1263 "UI/HSCurses/Curses.hsc" #-}
    (337)            -> KeySR
{-# LINE 1264 "UI/HSCurses/Curses.hsc" #-}
    (338)         -> KeyNPage
{-# LINE 1265 "UI/HSCurses/Curses.hsc" #-}
    (339)         -> KeyPPage
{-# LINE 1266 "UI/HSCurses/Curses.hsc" #-}
    (340)          -> KeySTab
{-# LINE 1267 "UI/HSCurses/Curses.hsc" #-}
    (341)          -> KeyCTab
{-# LINE 1268 "UI/HSCurses/Curses.hsc" #-}
    (342)         -> KeyCATab
{-# LINE 1269 "UI/HSCurses/Curses.hsc" #-}
    (343)         -> KeyEnter
{-# LINE 1270 "UI/HSCurses/Curses.hsc" #-}
    (344)        -> KeySReset
{-# LINE 1271 "UI/HSCurses/Curses.hsc" #-}
    (345)         -> KeyReset
{-# LINE 1272 "UI/HSCurses/Curses.hsc" #-}
    (346)         -> KeyPrint
{-# LINE 1273 "UI/HSCurses/Curses.hsc" #-}
    (347)            -> KeyLL
{-# LINE 1274 "UI/HSCurses/Curses.hsc" #-}
    (348)            -> KeyA1
{-# LINE 1275 "UI/HSCurses/Curses.hsc" #-}
    (349)            -> KeyA3
{-# LINE 1276 "UI/HSCurses/Curses.hsc" #-}
    (350)            -> KeyB2
{-# LINE 1277 "UI/HSCurses/Curses.hsc" #-}
    (351)            -> KeyC1
{-# LINE 1278 "UI/HSCurses/Curses.hsc" #-}
    (352)            -> KeyC3
{-# LINE 1279 "UI/HSCurses/Curses.hsc" #-}
    (353)          -> KeyBTab
{-# LINE 1280 "UI/HSCurses/Curses.hsc" #-}
    (354)           -> KeyBeg
{-# LINE 1281 "UI/HSCurses/Curses.hsc" #-}
    (355)        -> KeyCancel
{-# LINE 1282 "UI/HSCurses/Curses.hsc" #-}
    (356)         -> KeyClose
{-# LINE 1283 "UI/HSCurses/Curses.hsc" #-}
    (357)       -> KeyCommand
{-# LINE 1284 "UI/HSCurses/Curses.hsc" #-}
    (358)          -> KeyCopy
{-# LINE 1285 "UI/HSCurses/Curses.hsc" #-}
    (359)        -> KeyCreate
{-# LINE 1286 "UI/HSCurses/Curses.hsc" #-}
    (360)           -> KeyEnd
{-# LINE 1287 "UI/HSCurses/Curses.hsc" #-}
    (361)          -> KeyExit
{-# LINE 1288 "UI/HSCurses/Curses.hsc" #-}
    (362)          -> KeyFind
{-# LINE 1289 "UI/HSCurses/Curses.hsc" #-}
    (363)          -> KeyHelp
{-# LINE 1290 "UI/HSCurses/Curses.hsc" #-}
    (364)          -> KeyMark
{-# LINE 1291 "UI/HSCurses/Curses.hsc" #-}
    (365)       -> KeyMessage
{-# LINE 1292 "UI/HSCurses/Curses.hsc" #-}
    (366)          -> KeyMove
{-# LINE 1293 "UI/HSCurses/Curses.hsc" #-}
    (367)          -> KeyNext
{-# LINE 1294 "UI/HSCurses/Curses.hsc" #-}
    (368)          -> KeyOpen
{-# LINE 1295 "UI/HSCurses/Curses.hsc" #-}
    (369)       -> KeyOptions
{-# LINE 1296 "UI/HSCurses/Curses.hsc" #-}
    (370)      -> KeyPrevious
{-# LINE 1297 "UI/HSCurses/Curses.hsc" #-}
    (371)          -> KeyRedo
{-# LINE 1298 "UI/HSCurses/Curses.hsc" #-}
    (372)     -> KeyReference
{-# LINE 1299 "UI/HSCurses/Curses.hsc" #-}
    (373)       -> KeyRefresh
{-# LINE 1300 "UI/HSCurses/Curses.hsc" #-}
    (374)       -> KeyReplace
{-# LINE 1301 "UI/HSCurses/Curses.hsc" #-}
    (375)       -> KeyRestart
{-# LINE 1302 "UI/HSCurses/Curses.hsc" #-}
    (376)        -> KeyResume
{-# LINE 1303 "UI/HSCurses/Curses.hsc" #-}
    (377)          -> KeySave
{-# LINE 1304 "UI/HSCurses/Curses.hsc" #-}
    (378)          -> KeySBeg
{-# LINE 1305 "UI/HSCurses/Curses.hsc" #-}
    (379)       -> KeySCancel
{-# LINE 1306 "UI/HSCurses/Curses.hsc" #-}
    (380)      -> KeySCommand
{-# LINE 1307 "UI/HSCurses/Curses.hsc" #-}
    (381)         -> KeySCopy
{-# LINE 1308 "UI/HSCurses/Curses.hsc" #-}
    (382)       -> KeySCreate
{-# LINE 1309 "UI/HSCurses/Curses.hsc" #-}
    (383)           -> KeySDC
{-# LINE 1310 "UI/HSCurses/Curses.hsc" #-}
    (384)           -> KeySDL
{-# LINE 1311 "UI/HSCurses/Curses.hsc" #-}
    (385)        -> KeySelect
{-# LINE 1312 "UI/HSCurses/Curses.hsc" #-}
    (386)          -> KeySEnd
{-# LINE 1313 "UI/HSCurses/Curses.hsc" #-}
    (387)          -> KeySEOL
{-# LINE 1314 "UI/HSCurses/Curses.hsc" #-}
    (388)         -> KeySExit
{-# LINE 1315 "UI/HSCurses/Curses.hsc" #-}
    (389)         -> KeySFind
{-# LINE 1316 "UI/HSCurses/Curses.hsc" #-}
    (390)         -> KeySHelp
{-# LINE 1317 "UI/HSCurses/Curses.hsc" #-}
    (391)         -> KeySHome
{-# LINE 1318 "UI/HSCurses/Curses.hsc" #-}
    (392)           -> KeySIC
{-# LINE 1319 "UI/HSCurses/Curses.hsc" #-}
    (393)         -> KeySLeft
{-# LINE 1320 "UI/HSCurses/Curses.hsc" #-}
    (394)      -> KeySMessage
{-# LINE 1321 "UI/HSCurses/Curses.hsc" #-}
    (395)         -> KeySMove
{-# LINE 1322 "UI/HSCurses/Curses.hsc" #-}
    (396)         -> KeySNext
{-# LINE 1323 "UI/HSCurses/Curses.hsc" #-}
    (397)      -> KeySOptions
{-# LINE 1324 "UI/HSCurses/Curses.hsc" #-}
    (398)     -> KeySPrevious
{-# LINE 1325 "UI/HSCurses/Curses.hsc" #-}
    (399)        -> KeySPrint
{-# LINE 1326 "UI/HSCurses/Curses.hsc" #-}
    (400)         -> KeySRedo
{-# LINE 1327 "UI/HSCurses/Curses.hsc" #-}
    (401)      -> KeySReplace
{-# LINE 1328 "UI/HSCurses/Curses.hsc" #-}
    (402)        -> KeySRight
{-# LINE 1329 "UI/HSCurses/Curses.hsc" #-}
    (403)        -> KeySRsume
{-# LINE 1330 "UI/HSCurses/Curses.hsc" #-}
    (404)         -> KeySSave
{-# LINE 1331 "UI/HSCurses/Curses.hsc" #-}
    (405)      -> KeySSuspend
{-# LINE 1332 "UI/HSCurses/Curses.hsc" #-}
    (406)         -> KeySUndo
{-# LINE 1333 "UI/HSCurses/Curses.hsc" #-}
    (407)       -> KeySuspend
{-# LINE 1334 "UI/HSCurses/Curses.hsc" #-}
    (408)          -> KeyUndo
{-# LINE 1335 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1336 "UI/HSCurses/Curses.hsc" #-}
    (410)        -> KeyResize
{-# LINE 1337 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1338 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1339 "UI/HSCurses/Curses.hsc" #-}
    (409)         -> KeyMouse
{-# LINE 1340 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1341 "UI/HSCurses/Curses.hsc" #-}
    _                          -> KeyUnknown (fromIntegral key)

keyResizeCode :: Maybe CInt

{-# LINE 1345 "UI/HSCurses/Curses.hsc" #-}
keyResizeCode = Just (410)
{-# LINE 1346 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1349 "UI/HSCurses/Curses.hsc" #-}

cERR :: CInt
cERR :: Signal
cERR = -Signal
1
{-# LINE 1352 "UI/HSCurses/Curses.hsc" #-}

cKEY_UP, cKEY_DOWN, cKEY_LEFT, cKEY_RIGHT :: ChType
cKEY_UP :: Word32
cKEY_UP = Word32
259
{-# LINE 1355 "UI/HSCurses/Curses.hsc" #-}
cKEY_DOWN = 258
{-# LINE 1356 "UI/HSCurses/Curses.hsc" #-}
cKEY_LEFT = 260
{-# LINE 1357 "UI/HSCurses/Curses.hsc" #-}
cKEY_RIGHT = 261
{-# LINE 1358 "UI/HSCurses/Curses.hsc" #-}

cTRUE :: NBool
cTRUE :: NBool
cTRUE = NBool
1
{-# LINE 1361 "UI/HSCurses/Curses.hsc" #-}

-- ncurses ungetch and Haskell's threadWaitRead do not work together well.
-- So I decided to implement my own input queue.
ungetCh :: (Integral a) => a -> IO ()
ungetCh :: forall a. Integral a => a -> IO ()
ungetCh a
i = do
    String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"ungetCh called"
    Chan BufData -> BufData -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan BufData
inputBuf (Signal -> BufData
BufDirect (a -> Signal
forall a b. (Integral a, Num b) => a -> b
fi a
i))

data BufData
    = -- | Data directly available
      BufDirect CInt
    | -- | Data can be obtained by calling getch
      DataViaGetch

inputBuf :: Chan BufData
inputBuf :: Chan BufData
inputBuf = IO (Chan BufData) -> Chan BufData
forall a. IO a -> a
unsafePerformIO IO (Chan BufData)
forall a. IO (Chan a)
newChan
{-# NOINLINE inputBuf #-}

getchToInputBuf :: IO ()
getchToInputBuf :: IO ()
getchToInputBuf = do
    Fd -> IO ()
threadWaitRead (Int -> Fd
forall a b. (Integral a, Num b) => a -> b
fi (Int
0 :: Int))
    {- From the (n)curses manpage:
    Programmers  concerned  about portability should be prepared for either
    of two cases: (a) signal receipt does not interrupt getch;  (b)  signal
    receipt  interrupts getch and causes it to return ERR with errno set to
    EINTR.  Under the ncurses implementation, handled signals never  inter$B!>(B
    rupt getch.
    -}
    -- we only signalize that getch can now called without getting blocked.
    -- directly calling `getch' might result in losing the character just
    -- read (race condition).
    String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"now input available on stdin"
    Chan BufData -> BufData -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan BufData
inputBuf BufData
DataViaGetch

-- | Read a single character from the window.
getCh :: IO Key
getCh :: IO Key
getCh = do
  String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"getCh called"
  tid <- IO () -> IO ThreadId
forkIO IO ()
getchToInputBuf
  d <- readChan inputBuf
  -- we can kill the thread safely, because the thread does not read any data
  -- via getch
  killThread tid
  v <- case d of
         BufDirect Signal
x ->
           do String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"getCh: getting data directly from buffer"
              Signal -> IO Signal
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Signal
x
         BufData
DataViaGetch ->
           do String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"getCh: getting data via getch"
              IO Signal
getch -- won't block!
  case v of
    (-1) -> -- NO CODE IN THIS LINE
{-# LINE 1413 "UI/HSCurses/Curses.hsc" #-}
        do e <- IO Errno
getErrno
           if e `elem` [eAGAIN, eINTR]
              then do debug "Curses.getCh returned eAGAIN or eINTR"
                      getCh
              else throwErrno "HSCurses.Curses.getch"
    Signal
k -> let k' :: Key
k' = Signal -> Key
decodeKey Signal
k
             in do String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String
"getCh: result = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Key -> String
forall a. Show a => a -> String
show Key
k')
                   Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Key
k'

resizeTerminal :: Int -> Int -> IO ()


{-# LINE 1430 "UI/HSCurses/Curses.hsc" #-}
resizeTerminal :: Int -> Int -> IO ()
resizeTerminal Int
_ Int
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 1432 "UI/HSCurses/Curses.hsc" #-}

-- | The SIGWINCH signal is sent whenever the terminal size changes. This signal
-- is not available on all platforms, so it is a |Maybe| value.


{-# LINE 1439 "UI/HSCurses/Curses.hsc" #-}

cursesSigWinch :: Maybe Signal

{-# LINE 1442 "UI/HSCurses/Curses.hsc" #-}
cursesSigWinch = Just (28)
{-# LINE 1443 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1446 "UI/HSCurses/Curses.hsc" #-}

-- | A test case printing out some common attributes.
cursesTest :: IO ()
cursesTest :: IO ()
cursesTest = do
    IO Window
initScr
    hc <- IO Bool
hasColors
    when hc startColor
    ccc <- canChangeColor
    (ys,xs) <- scrSize
    cp <- colorPairs
    cs <- colors
    endWin
    putStrLn $ "ScreenSize: " ++ show (xs,ys)
    putStrLn $ "hasColors: " ++ show hc
    putStrLn $ "canChangeColor: " ++ show ccc
    putStrLn $ "colorPairs: " ++ show cp
    putStrLn $ "colors: " ++ show cs

-----------------------------------------------------------------------------
-- * Mouse routines
-----------------------------------------------------------------------------

data MouseEvent = MouseEvent
    { MouseEvent -> Signal
mouseEventId :: CInt
    , MouseEvent -> Signal
mouseEventX :: CInt
    , MouseEvent -> Signal
mouseEventY :: CInt
    , MouseEvent -> Signal
mouseEventZ :: CInt
    , MouseEvent -> [ButtonEvent]
mouseEventButton :: [ButtonEvent]
    }
    deriving (Int -> MouseEvent -> String -> String
[MouseEvent] -> String -> String
MouseEvent -> String
(Int -> MouseEvent -> String -> String)
-> (MouseEvent -> String)
-> ([MouseEvent] -> String -> String)
-> Show MouseEvent
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> MouseEvent -> String -> String
showsPrec :: Int -> MouseEvent -> String -> String
$cshow :: MouseEvent -> String
show :: MouseEvent -> String
$cshowList :: [MouseEvent] -> String -> String
showList :: [MouseEvent] -> String -> String
Show)

instance Storable MouseEvent where
    sizeOf :: MouseEvent -> Int
sizeOf MouseEvent
_ = ((Int
20))
{-# LINE 1479 "UI/HSCurses/Curses.hsc" #-}
    alignment _ = (4)
{-# LINE 1480 "UI/HSCurses/Curses.hsc" #-}
    peek ptr = do
        id' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 1482 "UI/HSCurses/Curses.hsc" #-}
        x <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 1483 "UI/HSCurses/Curses.hsc" #-}
        y <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 1484 "UI/HSCurses/Curses.hsc" #-}
        z <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 1485 "UI/HSCurses/Curses.hsc" #-}
        bstate :: (Word32) <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 1486 "UI/HSCurses/Curses.hsc" #-}
        pure $! MouseEvent id' x y z (besFromMouseMask bstate)
    poke :: Ptr MouseEvent -> MouseEvent -> IO ()
poke Ptr MouseEvent
ptr (MouseEvent Signal
id' Signal
x Signal
y Signal
z [ButtonEvent]
bstate) = do
        ((\Ptr MouseEvent
hsc_ptr -> Ptr MouseEvent -> Int -> Signal -> IO ()
forall b. Ptr b -> Int -> Signal -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MouseEvent
hsc_ptr Int
0)) Ptr MouseEvent
ptr Signal
id'
{-# LINE 1489 "UI/HSCurses/Curses.hsc" #-}
        ((\Ptr MouseEvent
hsc_ptr -> Ptr MouseEvent -> Int -> Signal -> IO ()
forall b. Ptr b -> Int -> Signal -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MouseEvent
hsc_ptr Int
4)) Ptr MouseEvent
ptr Signal
x
{-# LINE 1490 "UI/HSCurses/Curses.hsc" #-}
        ((\Ptr MouseEvent
hsc_ptr -> Ptr MouseEvent -> Int -> Signal -> IO ()
forall b. Ptr b -> Int -> Signal -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MouseEvent
hsc_ptr Int
8)) Ptr MouseEvent
ptr Signal
y
{-# LINE 1491 "UI/HSCurses/Curses.hsc" #-}
        ((\Ptr MouseEvent
hsc_ptr -> Ptr MouseEvent -> Int -> Signal -> IO ()
forall b. Ptr b -> Int -> Signal -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MouseEvent
hsc_ptr Int
12)) Ptr MouseEvent
ptr Signal
z
{-# LINE 1492 "UI/HSCurses/Curses.hsc" #-}
        ((\Ptr MouseEvent
hsc_ptr -> Ptr MouseEvent -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MouseEvent
hsc_ptr Int
16)) Ptr MouseEvent
ptr ([ButtonEvent] -> Word32
besToMouseMask [ButtonEvent]
bstate)
{-# LINE 1493 "UI/HSCurses/Curses.hsc" #-}

foreign import ccall unsafe "HSCurses.h getmouse"
    getmouse :: Ptr MouseEvent -> IO CInt

getMouse :: (MonadIO m) => m (Maybe MouseEvent)
getMouse :: forall (m :: * -> *). MonadIO m => m (Maybe MouseEvent)
getMouse = IO (Maybe MouseEvent) -> m (Maybe MouseEvent)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe MouseEvent) -> m (Maybe MouseEvent))
-> IO (Maybe MouseEvent) -> m (Maybe MouseEvent)
forall a b. (a -> b) -> a -> b
$ (Ptr MouseEvent -> IO (Maybe MouseEvent)) -> IO (Maybe MouseEvent)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr MouseEvent -> IO (Maybe MouseEvent))
 -> IO (Maybe MouseEvent))
-> (Ptr MouseEvent -> IO (Maybe MouseEvent))
-> IO (Maybe MouseEvent)
forall a b. (a -> b) -> a -> b
$ \Ptr MouseEvent
ptr -> do
    res <- Ptr MouseEvent -> IO Signal
getmouse Ptr MouseEvent
ptr
    if res == (0)
{-# LINE 1501 "UI/HSCurses/Curses.hsc" #-}
        then Just <$> peek ptr
        else pure Nothing

data ButtonEvent
    = ButtonPressed Int
    | ButtonReleased Int
    | ButtonClicked Int
    | ButtonDoubleClicked Int
    | ButtonTripleClicked Int
    | ButtonShift
    | ButtonControl
    | ButtonAlt
    deriving (ButtonEvent -> ButtonEvent -> Bool
(ButtonEvent -> ButtonEvent -> Bool)
-> (ButtonEvent -> ButtonEvent -> Bool) -> Eq ButtonEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ButtonEvent -> ButtonEvent -> Bool
== :: ButtonEvent -> ButtonEvent -> Bool
$c/= :: ButtonEvent -> ButtonEvent -> Bool
/= :: ButtonEvent -> ButtonEvent -> Bool
Eq, Int -> ButtonEvent -> String -> String
[ButtonEvent] -> String -> String
ButtonEvent -> String
(Int -> ButtonEvent -> String -> String)
-> (ButtonEvent -> String)
-> ([ButtonEvent] -> String -> String)
-> Show ButtonEvent
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ButtonEvent -> String -> String
showsPrec :: Int -> ButtonEvent -> String -> String
$cshow :: ButtonEvent -> String
show :: ButtonEvent -> String
$cshowList :: [ButtonEvent] -> String -> String
showList :: [ButtonEvent] -> String -> String
Show)

withMouseEventMask :: (MonadIO m) => [ButtonEvent] -> m a -> m a
withAllMouseEvents :: (MonadIO m) => m a -> m a


{-# LINE 1519 "UI/HSCurses/Curses.hsc" #-}

foreign import ccall unsafe "HSCurses.h mousemask"
    mousemask :: (Word32) -> Ptr (Word32) -> IO (Word32)
{-# LINE 1522 "UI/HSCurses/Curses.hsc" #-}

-- TODO: bracket instead?
withMouseEventMask :: forall (m :: * -> *) a. MonadIO m => [ButtonEvent] -> m a -> m a
withMouseEventMask [ButtonEvent]
bes m a
action = do
    ov <- IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr Word32
a ->  Word32 -> Ptr Word32 -> IO Word32
mousemask ([ButtonEvent] -> Word32
besToMouseMask [ButtonEvent]
bes) Ptr Word32
a IO Word32 -> IO Word32 -> IO Word32
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
a)
    r <- action
    liftIO $ mousemask ov nullPtr
    return r

withAllMouseEvents :: forall (m :: * -> *) a. MonadIO m => m a -> m a
withAllMouseEvents m a
action = do
    ov <- IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr Word32
a ->  Word32 -> Ptr Word32 -> IO Word32
mousemask (Word32
268435455) Ptr Word32
a IO Word32 -> IO Word32 -> IO Word32
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
a)
{-# LINE 1532 "UI/HSCurses/Curses.hsc" #-}
    r <- action
    liftIO $ mousemask ov nullPtr
    return r

besToMouseMask :: [ButtonEvent] -> (Word32)
{-# LINE 1537 "UI/HSCurses/Curses.hsc" #-}
besToMouseMask bes = foldl' (.|.) 0 (map cb bes) where
    cb (ButtonPressed 1) = (2)
{-# LINE 1539 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonPressed 2) = (64)
{-# LINE 1540 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonPressed 3) = (2048)
{-# LINE 1541 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonPressed 4) = (65536)
{-# LINE 1542 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonReleased 1) = (1)
{-# LINE 1543 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonReleased 2) = (32)
{-# LINE 1544 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonReleased 3) = (1024)
{-# LINE 1545 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonReleased 4) = (32768)
{-# LINE 1546 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonClicked 1) = (4)
{-# LINE 1547 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonClicked 2) = (128)
{-# LINE 1548 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonClicked 3) = (4096)
{-# LINE 1549 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonClicked 4) = (131072)
{-# LINE 1550 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonDoubleClicked 1) = (8)
{-# LINE 1551 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonDoubleClicked 2) = (256)
{-# LINE 1552 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonDoubleClicked 3) = (8192)
{-# LINE 1553 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonDoubleClicked 4) = (262144)
{-# LINE 1554 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonTripleClicked 1) = (16)
{-# LINE 1555 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonTripleClicked 2) = (512)
{-# LINE 1556 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonTripleClicked 3) = (16384)
{-# LINE 1557 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonTripleClicked 4) = (524288)
{-# LINE 1558 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1559 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonPressed 5) = (2097152)
{-# LINE 1560 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonReleased 5) = (1048576)
{-# LINE 1561 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonClicked 5) = (4194304)
{-# LINE 1562 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonDoubleClicked 5) = (8388608)
{-# LINE 1563 "UI/HSCurses/Curses.hsc" #-}
    cb (ButtonTripleClicked 5) = (16777216)
{-# LINE 1564 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1565 "UI/HSCurses/Curses.hsc" #-}
    cb ButtonShift = (67108864)
{-# LINE 1566 "UI/HSCurses/Curses.hsc" #-}
    cb ButtonAlt = (134217728)
{-# LINE 1567 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1568 "UI/HSCurses/Curses.hsc" #-}
    cb ButtonControl = (33554432)
{-# LINE 1569 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1572 "UI/HSCurses/Curses.hsc" #-}
    cb _ = 0

besFromMouseMask :: (Word32) -> [ButtonEvent]
{-# LINE 1575 "UI/HSCurses/Curses.hsc" #-}
besFromMouseMask mmask =
    foldl'
        (\evts (c, evt) -> if mmask .&. c /= 0 then evt : evts else evts)
        mempty
        mappings
  where
    mappings =
        [ ((2), ButtonPressed 1)
{-# LINE 1583 "UI/HSCurses/Curses.hsc" #-}
        , ((64), ButtonPressed 2)
{-# LINE 1584 "UI/HSCurses/Curses.hsc" #-}
        , ((2048), ButtonPressed 3)
{-# LINE 1585 "UI/HSCurses/Curses.hsc" #-}
        , ((65536), ButtonPressed 4)
{-# LINE 1586 "UI/HSCurses/Curses.hsc" #-}
        , ((1), ButtonReleased 1)
{-# LINE 1587 "UI/HSCurses/Curses.hsc" #-}
        , ((32), ButtonReleased 2)
{-# LINE 1588 "UI/HSCurses/Curses.hsc" #-}
        , ((1024), ButtonReleased 3)
{-# LINE 1589 "UI/HSCurses/Curses.hsc" #-}
        , ((32768), ButtonReleased 4)
{-# LINE 1590 "UI/HSCurses/Curses.hsc" #-}
        , ((4), ButtonClicked 1)
{-# LINE 1591 "UI/HSCurses/Curses.hsc" #-}
        , ((128), ButtonClicked 2)
{-# LINE 1592 "UI/HSCurses/Curses.hsc" #-}
        , ((4096), ButtonClicked 3)
{-# LINE 1593 "UI/HSCurses/Curses.hsc" #-}
        , ((131072), ButtonClicked 4)
{-# LINE 1594 "UI/HSCurses/Curses.hsc" #-}
        , ((8), ButtonDoubleClicked 1)
{-# LINE 1595 "UI/HSCurses/Curses.hsc" #-}
        , ((256), ButtonDoubleClicked 2)
{-# LINE 1596 "UI/HSCurses/Curses.hsc" #-}
        , ((8192), ButtonDoubleClicked 3)
{-# LINE 1597 "UI/HSCurses/Curses.hsc" #-}
        , ((262144), ButtonDoubleClicked 4)
{-# LINE 1598 "UI/HSCurses/Curses.hsc" #-}
        , ((16), ButtonTripleClicked 1)
{-# LINE 1599 "UI/HSCurses/Curses.hsc" #-}
        , ((512), ButtonTripleClicked 2)
{-# LINE 1600 "UI/HSCurses/Curses.hsc" #-}
        , ((16384), ButtonTripleClicked 3)
{-# LINE 1601 "UI/HSCurses/Curses.hsc" #-}
        , ((524288), ButtonTripleClicked 4)
{-# LINE 1602 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1603 "UI/HSCurses/Curses.hsc" #-}
        , ((2097152), ButtonPressed 5)
{-# LINE 1604 "UI/HSCurses/Curses.hsc" #-}
        , ((1048576), ButtonReleased 5)
{-# LINE 1605 "UI/HSCurses/Curses.hsc" #-}
        , ((4194304), ButtonClicked 5)
{-# LINE 1606 "UI/HSCurses/Curses.hsc" #-}
        , ((8388608), ButtonDoubleClicked 5)
{-# LINE 1607 "UI/HSCurses/Curses.hsc" #-}
        , ((16777216), ButtonTripleClicked 5)
{-# LINE 1608 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1609 "UI/HSCurses/Curses.hsc" #-}
        , ((67108864), ButtonShift)
{-# LINE 1610 "UI/HSCurses/Curses.hsc" #-}
        , ((134217728), ButtonAlt)
{-# LINE 1611 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1612 "UI/HSCurses/Curses.hsc" #-}
        , ((33554432), ButtonControl)
{-# LINE 1613 "UI/HSCurses/Curses.hsc" #-}

{-# LINE 1616 "UI/HSCurses/Curses.hsc" #-}
        ]


{-# LINE 1624 "UI/HSCurses/Curses.hsc" #-}

ulCorner :: Char
ulCorner :: Char
ulCorner = Int -> Char
chr Int
0x250C

llCorner :: Char
llCorner :: Char
llCorner = Int -> Char
chr Int
0x2514

urCorner :: Char
urCorner :: Char
urCorner = Int -> Char
chr Int
0x2510

lrCorner :: Char
lrCorner :: Char
lrCorner = Int -> Char
chr Int
0x2518

rTee :: Char
rTee :: Char
rTee = Int -> Char
chr Int
0x2524

lTee :: Char
lTee :: Char
lTee = Int -> Char
chr Int
0x251C

bTee :: Char
bTee :: Char
bTee = Int -> Char
chr Int
0x2534

tTee :: Char
tTee :: Char
tTee = Int -> Char
chr Int
0x252C

hLine :: Char
hLine :: Char
hLine = Int -> Char
chr Int
0x2500

vLine :: Char
vLine :: Char
vLine = Int -> Char
chr Int
0x2502

plus :: Char
plus :: Char
plus = Int -> Char
chr Int
0x253C

s1 :: Char
s1 :: Char
s1 = Int -> Char
chr Int
0x23BA -- was: 0xF800

s9 :: Char
s9 :: Char
s9 = Int -> Char
chr Int
0x23BD -- was: 0xF804

diamond :: Char
diamond :: Char
diamond = Int -> Char
chr Int
0x25C6

ckBoard :: Char
ckBoard :: Char
ckBoard = Int -> Char
chr Int
0x2592

degree :: Char
degree :: Char
degree = Int -> Char
chr Int
0x00B0

plMinus :: Char
plMinus :: Char
plMinus = Int -> Char
chr Int
0x00B1

bullet :: Char
bullet :: Char
bullet = Int -> Char
chr Int
0x00B7

lArrow :: Char
lArrow :: Char
lArrow = Int -> Char
chr Int
0x2190

rArrow :: Char
rArrow :: Char
rArrow = Int -> Char
chr Int
0x2192

dArrow :: Char
dArrow :: Char
dArrow = Int -> Char
chr Int
0x2193

uArrow :: Char
uArrow :: Char
uArrow = Int -> Char
chr Int
0x2191

board :: Char
board :: Char
board = Int -> Char
chr Int
0x2591

lantern :: Char
lantern :: Char
lantern = Int -> Char
chr Int
0x256C

block :: Char
block :: Char
block = Int -> Char
chr Int
0x2588

s3 :: Char
s3 :: Char
s3 = Int -> Char
chr Int
0x23BB -- was: 0xF801

s7 :: Char
s7 :: Char
s7 = Int -> Char
chr Int
0x23BC -- was: 0xF803

lEqual :: Char
lEqual :: Char
lEqual = Int -> Char
chr Int
0x2264

gEqual :: Char
gEqual :: Char
gEqual = Int -> Char
chr Int
0x2265

pi :: Char
pi :: Char
pi = Int -> Char
chr Int
0x03C0

nEqual :: Char
nEqual :: Char
nEqual = Int -> Char
chr Int
0x2260

sterling :: Char
sterling :: Char
sterling = Int -> Char
chr Int
0x00A3

recognize :: Char -> IO a -> (ChType -> IO a) -> IO a
recognize :: forall a. Char -> IO a -> (Word32 -> IO a) -> IO a
recognize Char
_ch IO a
noConvert Word32 -> IO a
_convert = IO a
noConvert -- Handle the most common case first.