diff --git a/lib/UI/NCurses.chs b/lib/UI/NCurses.chs --- a/lib/UI/NCurses.chs +++ b/lib/UI/NCurses.chs @@ -1,5 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-} ------------------------------------------------------------------------------ + -- Copyright (C) 2010 John Millikin -- -- This program is free software: you can redistribute it and/or modify @@ -14,16 +14,7 @@ -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . ------------------------------------------------------------------------------ --- | --- Module: UI.NCurses --- Copyright: 2010 John Millikin --- License: GPL-3 --- --- Maintainer: jmillikin@gmail.com --- Portability: portable (requires FFI) --- ------------------------------------------------------------------------------ + module UI.NCurses ( -- * Primary types @@ -122,6 +113,10 @@ , ButtonState (..) , MouseState (..) + -- * Cursor mode + , CursorMode(CursorInvisible, CursorVisible, CursorVeryVisible) + , setCursorMode + -- * misc , setRaw , setCBreak @@ -137,39 +132,35 @@ , setKeypad , getCursor ) where --- Imports {{{ -import Control.Exception (bracket_) -import Control.Monad (when, unless) + +import Control.Exception (bracket_) +import Control.Monad (when, unless) import qualified Control.Monad.Trans.Reader as R -import Data.Char (chr, ord) -import Data.List (foldl') -import Data.Maybe (catMaybes) +import Data.Char (chr, ord) +import Data.List (foldl') +import Data.Maybe (catMaybes) import qualified Data.Map as M import qualified Data.Text as T -import UI.NCurses.Types +import Foreign hiding (shift) +import Foreign.C + + import qualified UI.NCurses.Enums as E --- }}} +import UI.NCurses.Types --- c2hs setup {{{ #define NCURSES_ENABLE_STDBOOL_H 0 #define _XOPEN_SOURCE_EXTENDED #define NCURSES_NOMACROS #include #include -import Foreign hiding (shift) -import Foreign.C - {# pointer *WINDOW as Window nocode #} {# pointer *cchar_t as CCharT newtype #} {# pointer *wchar_t as CWString nocode #} type AttrT = {# type attr_t #} type MMaskT = {# type mmask_t #} --- }}} --- Initialization {{{ - -- | Put the terminal in graphical mode, including enabling special keys, -- colors, and mouse events (if supported). -- @@ -199,10 +190,6 @@ foreign import ccall "static &stdscr" c_stdscr :: Ptr (Ptr Window) --- }}} - --- Window management {{{ - -- | Create a new 'Window', with the given dimensions. To create a -- fullscreen window, use @'newWindow' 0 0 0 0@. -- @@ -245,10 +232,6 @@ then error "cloneWindow: dupwin() returned NULL" else return win --- }}} - --- Drawing to the screen {{{ - -- | Apply a window update to the window. After all of an -- application’s windows have been updated, call 'render' to update -- the terminal’s contents. @@ -335,10 +318,6 @@ withGlyph (Just g) $ \pChar -> {# call wbkgrndset #} win pChar >> return 0 --- }}} - --- Attributes {{{ - data Attribute = AttributeStandout | AttributeUnderline @@ -383,10 +362,6 @@ colorPair <- peek pPair {# call wattr_set #} win cint colorPair nullPtr --- }}} - --- Colors {{{ - data Color = ColorBlack | ColorRed @@ -496,10 +471,6 @@ foreign import ccall "static &COLOR_PAIRS" c_COLOR_PAIRS :: Ptr CInt --- }}} - --- Glyphs {{{ - -- | A glyph is a character, typically spacing, combined with a set of -- attributes. data Glyph = Glyph @@ -519,8 +490,6 @@ {# set cchar_t->chars #} pBuf (wordPtrToPtr (fromIntegral (ord char))) io (CCharT pBuf) --- VT100 drawing glyphs {{{ - -- | Upper left corner glyphCornerUL :: Glyph glyphCornerUL = Glyph '\x250C' [] @@ -593,10 +562,6 @@ glyphBullet :: Glyph glyphBullet = Glyph '\xb7' [] --- }}} - --- Teletype 5410v1 symbols {{{ - -- | Arrow pointing left glyphArrowL :: Glyph glyphArrowL = Glyph '\x2190' [] @@ -625,10 +590,6 @@ glyphBlock :: Glyph glyphBlock = Glyph '\x25AE' [] --- }}} - --- Other glyphs {{{ - -- | Scan line 3 glyphS3 :: Glyph glyphS3 = Glyph '\x23BB' [] @@ -657,12 +618,6 @@ glyphSterling :: Glyph glyphSterling = Glyph '\xa3' [] --- }}} - --- }}} - --- Event handling {{{ - data Event = EventCharacter Char | EventSpecialKey Key @@ -722,8 +677,6 @@ Just key -> EventSpecialKey key Nothing -> EventUnknown code --- Keyboard events {{{ - data Key = KeyUpArrow | KeyDownArrow @@ -902,10 +855,6 @@ , (E.KEY_UNDO, KeyUndo) ] --- }}} - --- Mouse events {{{ - data ButtonState = ButtonPressed | ButtonReleased @@ -981,11 +930,29 @@ button5 = Nothing #endif --- }}} - --- }}} +data CursorMode + = CursorInvisible + | CursorVisible + | CursorVeryVisible + | CursorModeUnknown CInt + deriving (Eq, Show) --- misc {{{ +-- | Set the current cursor mode to visible, invisible, or \"very visible\". +-- The previous cursor mode is returned. +setCursorMode :: CursorMode -> Curses CursorMode +setCursorMode mode = Curses $ do + let intMode = case mode of + CursorInvisible -> 0 + CursorVisible -> 1 + CursorVeryVisible -> 2 + CursorModeUnknown n -> n + rc <- {# call curs_set #} intMode + checkRC "setCursorMode" rc + return $ case rc of + 0 -> CursorInvisible + 1 -> CursorVisible + 2 -> CursorVeryVisible + _ -> CursorModeUnknown rc -- | Runs @raw()@ or @noraw()@ setRaw :: Bool -> Curses () @@ -1073,14 +1040,8 @@ col <- {# call getcurx #} win return (toInteger row, toInteger col) --- }}} - --- Utility {{{ - withWindow :: (Window -> IO a) -> Update a withWindow io = Update (R.ReaderT (\win -> Curses (io win))) withWindow_ :: String -> (Window -> IO CInt) -> Update () withWindow_ name io = withWindow $ \win -> io win >>= checkRC name - --- }}} diff --git a/lib/UI/NCurses/Enums.chs b/lib/UI/NCurses/Enums.chs --- a/lib/UI/NCurses/Enums.chs +++ b/lib/UI/NCurses/Enums.chs @@ -1,4 +1,3 @@ ------------------------------------------------------------------------------ -- Copyright (C) 2010 John Millikin -- -- This program is free software: you can redistribute it and/or modify @@ -13,13 +12,13 @@ -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . ------------------------------------------------------------------------------ -module UI.NCurses.Enums where --- this module is a hack to work around c2hs's lack of #define hooks. +-- | This module is a hack to work around c2hs's lack of #define hooks. -- the idea is to create a new class 'Enum' which uses 'Integer' instead -- of 'Int', so integral defines of any size can be retrieved. -import Prelude (Integer, error, show, (++)) +module UI.NCurses.Enums where + +import Prelude (Integer, error, show, (++)) #define NCURSES_ENABLE_STDBOOL_H 0 #define _XOPEN_SOURCE_EXTENDED diff --git a/lib/UI/NCurses/Panel.chs b/lib/UI/NCurses/Panel.chs --- a/lib/UI/NCurses/Panel.chs +++ b/lib/UI/NCurses/Panel.chs @@ -1,5 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-} ------------------------------------------------------------------------------ + -- Copyright (C) 2010 John Millikin -- -- This program is free software: you can redistribute it and/or modify @@ -14,16 +14,7 @@ -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . ------------------------------------------------------------------------------ --- | --- Module: UI.NCurses.Panel --- Copyright: 2010 John Millikin --- License: GPL-3 --- --- Maintainer: jmillikin@gmail.com --- Portability: portable (requires FFI) --- ------------------------------------------------------------------------------ + module UI.NCurses.Panel ( Panel , newPanel @@ -42,12 +33,12 @@ , getPanelWindow , replacePanelWindow ) where -import Foreign -import Foreign.C -import UI.NCurses.Types --- for haddock -import UI.NCurses (render) +import Foreign +import Foreign.C + +import UI.NCurses (render) -- for haddock +import UI.NCurses.Types #include diff --git a/lib/UI/NCurses/Types.hs b/lib/UI/NCurses/Types.hs --- a/lib/UI/NCurses/Types.hs +++ b/lib/UI/NCurses/Types.hs @@ -1,4 +1,3 @@ ------------------------------------------------------------------------------ -- Copyright (C) 2010 John Millikin -- -- This program is free software: you can redistribute it and/or modify @@ -13,18 +12,18 @@ -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . ------------------------------------------------------------------------------ + module UI.NCurses.Types where + import qualified Control.Applicative as A -import Control.Monad (liftM, ap) -import Control.Monad.Fix (MonadFix, mfix) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad (liftM, ap) +import Control.Monad.Fix (MonadFix, mfix) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Reader (ReaderT) import qualified Foreign as F import qualified Foreign.C as F -import qualified UI.NCurses.Enums as E --- newtype Curses {{{ +import qualified UI.NCurses.Enums as E -- | A small wrapper around 'IO', to ensure the @ncurses@ library is -- initialized while running. @@ -47,10 +46,6 @@ pure = return (<*>) = ap --- }}} - --- newtype Update {{{ - newtype Update a = Update { unUpdate :: ReaderT Window Curses a } instance Monad Update where @@ -66,8 +61,6 @@ instance A.Applicative Update where pure = return (<*>) = ap - --- }}} newtype Window = Window { windowPtr :: F.Ptr Window } diff --git a/ncurses.cabal b/ncurses.cabal --- a/ncurses.cabal +++ b/ncurses.cabal @@ -1,5 +1,5 @@ name: ncurses -version: 0.2.1 +version: 0.2.2 license: GPL-3 license-file: license.txt author: John Millikin @@ -56,7 +56,7 @@ source-repository head type: bazaar location: https://john-millikin.com/branches/haskell-ncurses/0.2/ - tag: haskell-ncurses_0.2.1 + tag: haskell-ncurses_0.2.2 library hs-source-dirs: lib