vty 3.1.6 → 3.1.8
raw patch · 7 files changed
+312/−208 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Graphics.Vty: TS :: !Int -> !Int -> !Attr -> TermState
+ Graphics.Vty: _tsAttr :: TermState -> !Attr
+ Graphics.Vty: _tsColumn :: TermState -> !Int
+ Graphics.Vty: _tsRow :: TermState -> !Int
+ Graphics.Vty: data TermState
+ Graphics.Vty: mkVtyEscDelay :: Int -> IO Vty
Files
- Graphics/Vty.hs +84/−41
- Graphics/Vty/ControlStrings.hs +16/−0
- Graphics/Vty/Cursor.hs +29/−134
- Graphics/Vty/LLInput.hs +58/−30
- Graphics/Vty/Output.hs +114/−0
- Graphics/Vty/Types.hs +5/−1
- vty.cabal +6/−2
Graphics/Vty.hs view
@@ -1,19 +1,29 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ForeignFunctionInterface, BangPatterns #-} {-# CFILES gwinsz.c #-} -- Good sources of documentation for terminal programming are: -- vt100 control sequences: http://vt100.net/docs/vt100-ug/chapter3.html#S3.3.3 -- Xterm control sequences: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html -module Graphics.Vty (Vty(..), beep, mkVty, module Graphics.Vty.Types, Key(..), Modifier(..), Button(..), Event(..)) where+module Graphics.Vty ( Vty(..)+ , beep+ , mkVty+ , mkVtyEscDelay+ , module Graphics.Vty.Types+ , Key(..)+ , Modifier(..)+ , Button(..)+ , Event(..)+ ) + where import Control.Concurrent -import Graphics.Vty.Types hiding (Color, Attr, Image, fillSeg)-import Graphics.Vty.Types (Color(), Attr(), Image())+import Graphics.Vty.Types import qualified Graphics.Vty.Types as T(Color(..), Attr(..), Image(..), fillSeg) import Graphics.Vty.Cursor import Graphics.Vty.LLInput+import Graphics.Vty.Output import Foreign.Marshal.Array import Foreign.Marshal.Alloc@@ -21,12 +31,14 @@ import Foreign.Storable import Foreign.Ptr +import System.Console.Terminfo+ -- |The main object. At most one should be created. data Vty = Vty { -- |Update the screen to reflect the contents of a 'Picture'. -- This is not currently threadsafe. update :: Picture -> IO (), -- |Get one Event object, blocking if necessary.- getEvent :: IO Event,+ getEvent :: IO Event, -- |Get the size of the display. getSize :: IO (Int,Int), -- |Refresh the display. Normally the library takes care of refreshing. @@ -34,51 +46,82 @@ -- In that case the user might want to force a refresh. refresh :: IO (), -- |Clean up after vty.- shutdown :: IO () }+ shutdown :: IO () + } -- |Set up the state object for using vty. At most one state object should be -- created at a time. mkVty :: IO Vty-mkVty = do (tstate, endo) <- initTermOutput- (kvar, endi) <- initTermInput- state <- newMVar =<< fmap ((,,,) tstate (-1) (-1)) (mallocArray 2)- intMkVty kvar (endi >> endo) state+mkVty = mkVtyEscDelay 0 +mkVtyEscDelay :: Int -> IO Vty+mkVtyEscDelay escDelay = do + terminal <- setupTermFromEnv + (tstate, endo) <- initTermOutput terminal+ (kvar, endi) <- initTermInput escDelay terminal+ state <- newMVar =<< fmap ((,,,) tstate (-1) (-1)) (mallocArray 2)+ intMkVty kvar (endi >> endo) state++ intMkVty :: IO Event -> IO () -> MVar (TermState, Int, Int, Ptr Int) -> IO Vty-intMkVty kvar fend rstate = return rec where+intMkVty kvar fend rstate = + return $ Vty { update = update' + , getEvent = gkey+ , getSize = ulift getwinsize+ , refresh = refr+ , shutdown = fend + }+ where+ ulift :: (TermState -> IO (a, TermState)) -> IO a+ ulift f = modifyMVar rstate (\(v,a,b,c) -> fmap (\(x,y) -> ((y,a,b,c),x)) (f v)) - ulift :: (TermState -> IO (a, TermState)) -> IO a- ulift f = modifyMVar rstate (\(v,a,b,c) -> fmap (\(x,y) -> ((y,a,b,c),x)) (f v))+ update' (Pic nc (T.Image wr w h)) = modifyMVar_ rstate $ \(ts0, fbw, fbh, oldptr) -> do+ (shd,ts1) <- case (fbw,fbh) == (w,h) of+ True -> return (oldptr,ts0)+ False -> do new <- throwIfNull "clrscr realloc" $ reallocArray oldptr (w * h * 2)+ T.fillSeg attr ' ' new (new `advancePtr` (w * h * 2))+ fmap ((,) new) (clrscr ts0)+ fb <- throwIfNull "update alloc" $ mallocArray (w * h * 2)+ wr (w * 2 * sizeOf (undefined :: Int)) fb+ ts2 <- diffs w h shd fb ts1+ ts3 <- case nc of + NoCursor -> setCursorInvis ts2+ Cursor x y -> move w x y ts2 >>= setCursorVis+ ts4 <- flush ts3+ free shd+ return (ts4, w, h, fb) - rec = Vty { update = update' - , getEvent = gkey- , getSize = ulift getwinsize- , refresh = refr- , shutdown = fend }+ -- just refresh+ refr = modifyMVar_ rstate $ \(ts0,_,_,p) -> + fmap (\(_,ts1) -> (ts1,(-1),(-1),p)) (getwinsize ts0) - update' (Pic nc (T.Image wr w h)) = modifyMVar_ rstate $ \(ts0, fbw, fbh, oldptr) -> do- (shd,ts1) <- case (fbw,fbh) == (w,h) of- True -> return (oldptr,ts0)- False -> do new <- throwIfNull "clrscr realloc" $ reallocArray oldptr (w * h * 2)- T.fillSeg attr ' ' new (new `advancePtr` (w * h * 2))- fmap ((,) new) (clrscr ts0)- fb <- throwIfNull "update alloc" $ mallocArray (w * h * 2)- wr (w * 2 * sizeOf (undefined :: Int)) fb- ts2 <- diffs w h shd fb ts1- ts3 <- case nc of NoCursor -> setCursorInvis ts2- Cursor x y -> move w x y ts2 >>= setCursorVis- ts4 <- flush ts3- free shd- return (ts4, w, h, fb)+ -- refresh and return a state event+ inval = modifyMVar rstate $ \(ts0,_,_,p) -> + fmap (\((x,y),ts1) -> ((ts1,(-1),(-1),p),EvResize x y)) (getwinsize ts0) - -- just refresh- refr = modifyMVar_ rstate $ \(ts0,_,_,p) ->- fmap (\(_,ts1) -> (ts1,(-1),(-1),p)) (getwinsize ts0)+ gkey = do k <- kvar+ case k of + (EvResize _ _) -> inval+ _ -> return k - -- refresh and return a state event- inval = modifyMVar rstate $ \(ts0,_,_,p) ->- fmap (\((x,y),ts1) -> ((ts1,(-1),(-1),p),EvResize x y)) (getwinsize ts0)+{- |Given the width and height of a text region along with the old text for the region and the new+ - text for the region this only outputs the changes between the two regions to the terminal.+ - TODO: This needs to be updated to account for issue #10. + -}+diffs :: Int -> Int -> Ptr Int -> Ptr Int -> TermState -> IO TermState+diffs !w !h !old !new !state = diffs' 0 0 old new state+ where+ diffs' :: Int -> Int -> Ptr Int -> Ptr Int -> TermState -> IO TermState+ diffs' !x !y !olp !nwp !stat+ | y == h = return stat+ | x == w = diffs' 0 (y+1) olp nwp stat+ | otherwise = do ola <- peek olp+ nwa <- peek nwp+ olc <- peekElemOff olp 1+ nwc <- peekElemOff nwp 1+ stat' <- case (ola /= nwa || olc /= nwc) of+ False -> return stat+ True -> mvputch w x y (toEnum nwc) (Attr nwa) stat+ diffs' (x+1) y (olp `advancePtr` 2) (nwp `advancePtr` 2) stat' - gkey = do k <- kvar- case k of (EvResize _ _) -> inval- _ -> return k+
+ Graphics/Vty/ControlStrings.hs view
@@ -0,0 +1,16 @@+module Graphics.Vty.ControlStrings + where++csi, cvis, civis :: String++csi = "\ESC["++setCursorPosition :: Int -> Int -> String+setCursorPosition row column = csi ++ show row ++ ";" ++ show column ++ "H"++-- | Show the cursor+cvis = csi ++ "?25h" ++-- | Hide the cursor+civis = csi ++ "?25l"+
Graphics/Vty/Cursor.hs view
@@ -1,37 +1,33 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ForeignFunctionInterface, BangPatterns #-} {-# CFILES gwinsz.c #-}-module Graphics.Vty.Cursor- ( TermState, diffs, move, initTermOutput, clrscr, getwinsize, beep, flush,- setCursorInvis, setCursorVis ) where--import Foreign.C.Types( CLong )-import Foreign.Ptr( Ptr )-import System.IO( stdout, hFlush )-import Foreign.Storable( peekElemOff, peek )-import Foreign.Marshal.Array( advancePtr )--import Control.Monad( when )--import Data.Bits( (.|.), (.&.), shiftR )+module Graphics.Vty.Cursor ( move+ , setCursorInvis+ , setCursorVis + , mvputch+ ) + where import Graphics.Vty.Types+import Graphics.Vty.ControlStrings+import Graphics.Vty.Output ( chgatt+ ,tputchar+ ,putShow+ ) --- | An object representing the current state of the terminal.-data TermState = TS {_tsRow :: !Int, _tsColumn :: !Int, _tsAttr :: !Attr}+import Control.Monad ( when ) --- | Set up the terminal for output, and create an object representing the--- initial state. Also returns a function for shutting down the terminal access.-initTermOutput :: IO (TermState, IO ())-initTermOutput = do putStr reset- let uninit = do (_,sy) <- getwinsize_- putStr (endterm sy)- hFlush stdout- return (TS 0 0 attr, uninit)+{-+import Data.Bits ( (.|.), (.&.), shiftR )+import Data.Maybe ( maybe ) --- | Force sent commands to be respected.-flush :: TermState -> IO TermState-flush ts = hFlush stdout >> return ts+import Foreign.C.Types ( CLong )+import Foreign.Ptr ( Ptr )+import Foreign.Storable ( peekElemOff, peek )+import Foreign.Marshal.Array ( advancePtr ) +import System.IO ( stdout, hFlush )+-}+ -- | Move the cursor to (x,y); sx is the current width of the screen. -- (this is a bit of a hack, forcing clients to cache that data) move :: Int -> Int -> Int -> TermState -> IO TermState@@ -41,17 +37,12 @@ -- | Put a (char,attr) at a given (x,y) cursor position; sx is the -- current width of the screen. (this is a bit of a hack, forcing -- clients to cache that data)-mvputch :: Int -> Int -> Int -> (Char,Attr) -> TermState -> IO TermState-mvputch sx x y (ch,att) ts | sx `seq` x `seq` y `seq` ch `seq` att `seq` ts `seq` False = undefined-mvputch sx x y (ch,att) (TS ox oy oat) = do movcsr y oy x ox sx- when (att /= oat) $ chgatt att- tputchar ch- return (TS (x+1) y att)---- | Reset the screen.-clrscr :: TermState -> IO TermState-clrscr _ts = do putStr reset- return (TS 0 0 attr)+mvputch :: Int -> Int -> Int -> Char -> Attr -> TermState -> IO TermState+mvputch !sx !x !y !ch !att !(TS ox oy oat) = do + movcsr y oy x ox sx+ when (att /= oat) $ chgatt att+ tputchar ch+ return (TS (x+1) y att) -- | Make the cursor invisible. setCursorInvis :: TermState -> IO TermState@@ -61,51 +52,6 @@ setCursorVis :: TermState -> IO TermState setCursorVis ts = putStr cvis >> return ts -diffs :: Int -> Int -> Ptr Int -> Ptr Int -> TermState -> IO TermState-diffs w h old new state | w `seq` h `seq` old `seq` new `seq` state `seq` False = undefined-diffs w h old new state = diffs' 0 0 old new state- where- diffs' :: Int -> Int -> Ptr Int -> Ptr Int -> TermState -> IO TermState- diffs' x y olp nwp stat- | x `seq` y `seq` olp `seq` nwp `seq` stat `seq` False = undefined- | y == h = return stat- | x == w = diffs' 0 (y+1) olp nwp stat- | otherwise = do ola <- peek olp- nwa <- peek nwp- olc <- peekElemOff olp 1- nwc <- peekElemOff nwp 1- stat' <- case (ola /= nwa || olc /= nwc) of- False -> return stat- True -> mvputch w x y (toEnum nwc, Attr nwa) stat- diffs' (x+1) y (olp `advancePtr` 2) (nwp `advancePtr` 2) stat'---- ANSI specific bits-chgatt :: Attr -> IO ()-chgatt (Attr bf)- = putStr "\ESC[0;" >>- putShow (bf .&. 0xFF) >> - putStr ";" >> putShow ((bf `shiftR` 8) .&. 0xFF) >> - 0x10000 ? ";1" >>- 0x20000 ? ";5" >> 0x40000 ? ";7" >> 0x80000 ? ";2" >> 0x100000 ? ";4" >> - putStr "m"- where- {-# INLINE (?) #-}- (?) :: Int -> [Char] -> IO ()- field ? x | bf .&. field == 0 = return ()- | otherwise = putStr x--tputchar :: Char -> IO ()-tputchar ch | ich < 0x80 = pch ich- | ich < 0x800 = pch (0xC0 .|. (ich `usr` 6)) >> pch (0x80 .|. (0x3F .&. ich))- | ich < 0x10000 = pch (0xE0 .|. (ich `usr` 12)) >> pch (0x80 .|. (0x3F .&. (ich `usr` 6))) >>- pch (0x80 .|. (0x3F .&. ich))- | otherwise = pch (0xF0 .|. (ich `usr` 24)) >> pch (0x80 .|. (0x3F .&. (ich `usr` 12))) >>- pch (0x80 .|. (0x3F .&. (ich `usr` 6))) >> pch (0x80 .|. (0x3F .&. ich))- where ich = fromEnum ch- pch = putChar . toEnum- usr = shiftR-- -- we always use absolute motion between lines to work around diffs movcsr :: Int -> Int -> Int -> Int -> Int -> IO () movcsr y oy x ox wid@@ -115,55 +61,4 @@ | x > ox = putStr "\ESC[" >> putShow (x - ox) >> putChar 'C' | otherwise = putStr "\ESC[" >> putShow (ox - x) >> putChar 'D' {-# INLINE movcsr #-}--putShow :: Int -> IO ()-putShow n = when (ini /= 0) (putShow ini) >> putChar (toEnum (lst + 48))- where (ini, lst) = divMod n 10--- {-# INLINE putShow #-}--foreign import ccall "gwinsz.h c_get_window_size" c_get_window_size :: IO CLong-getwinsize_ :: IO (Int,Int)-getwinsize_ = do (a,b) <- (`divMod` 65536) `fmap` c_get_window_size- return (fromIntegral b, fromIntegral a)-getwinsize :: TermState -> IO ((Int,Int), TermState)-getwinsize ts = do (a,b) <- (`divMod` 65536) `fmap` c_get_window_size- return ((fromIntegral b, fromIntegral a), ts)---csi, cvis, civis, reset :: String--csi = "\ESC["--reset = "\ESCc" ++ -- full reset- utf8CharSet ++ - setCursorPosition 1 1 ++- "\ESC[2J" -- erase all--setCursorPosition :: Int -> Int -> String-setCursorPosition row column = csi ++ show row ++ ";" ++ show column ++ "H"---- | Make the terminal beep.-beep :: IO ()-beep = putStr "\BEL" ---- | Show the cursor-cvis = csi ++ "?25h" ---- | Hide the cursor-civis = csi ++ "?25l"--defaultCharSet, utf8CharSet :: String-defaultCharSet = "\ESC%@"-utf8CharSet = "\ESC%G"---- | Restore the terminal to a good state for the shell.--- Parameter is the line where the cursor should appear.-endterm :: Int -> [Char]-endterm sy = setCursorPosition sy 1 ++- "\ESC[0;39;49m" ++ -- graphic rendition- defaultCharSet ++ - "\CR" ++ - cvis ++- "\ESC[K" -- erase line-
Graphics/Vty/LLInput.hs view
@@ -1,10 +1,16 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE ForeignFunctionInterface #-}-module Graphics.Vty.LLInput- ( Key(..), Modifier(..), Button(..), Event(..), initTermInput ) where+module Graphics.Vty.LLInput ( Key(..)+ , Modifier(..)+ , Button(..)+ , Event(..)+ , initTermInput + ) + where import Data.Char-import Data.Maybe( mapMaybe )+import Data.Maybe ( mapMaybe + ) import Data.List( inits ) import Data.Word import qualified Data.Map as M( fromList, lookup )@@ -12,76 +18,97 @@ import Codec.Binary.UTF8.Generic (decode) +import Control.Monad (when) import Control.Concurrent import Control.Exception++import System.Console.Terminfo+ import System.Posix.Signals.Exts import System.Posix.Signals import System.Posix.Terminal-import System.Console.Terminfo--import System.Posix.IO (stdInput, fdRead, setFdOption, FdOption(..))+import System.Posix.IO ( stdInput+ ,fdRead+ ,setFdOption+ ,FdOption(..)+ ) -- |Representations of non-modifier keys. data Key = KEsc | KFun Int | KBackTab | KPrtScr | KPause | KASCII Char | KBS | KIns | KHome | KPageUp | KDel | KEnd | KPageDown | KNP5 | KUp | KMenu- | KLeft | KDown | KRight | KEnter deriving (Eq,Show,Ord)+ | KLeft | KDown | KRight | KEnter + deriving (Eq,Show,Ord)+ -- |Modifier keys. Key codes are interpreted such that users are more likely to -- have Meta than Alt; for instance on the PC Linux console, 'MMeta' will -- generally correspond to the physical Alt key.-data Modifier = MShift | MCtrl | MMeta | MAlt deriving (Eq,Show,Ord)+data Modifier = MShift | MCtrl | MMeta | MAlt + deriving (Eq,Show,Ord)+ -- |Mouse buttons. Not yet used.-data Button = BLeft | BMiddle | BRight deriving (Eq,Show,Ord)+data Button = BLeft | BMiddle | BRight + deriving (Eq,Show,Ord)+ -- |Generic events. data Event = EvKey Key [Modifier] | EvMouse Int Int Button [Modifier]- | EvResize Int Int deriving (Eq,Show,Ord)----import GHC.Conc (labelThread)-threadName :: String -> IO ()---threadName str = myThreadId >>= flip labelThread str-threadName _str = return ()+ | EvResize Int Int + deriving (Eq,Show,Ord) data KClass = Valid Key [Modifier] | Invalid | Prefix | MisPfx Key [Modifier] [Char] deriving(Show) -- | Set up the terminal for input. Returns a function which reads key -- events, and a function for shutting down the terminal access.-initTermInput :: IO (IO Event, IO ())-initTermInput = do- threadName "main"+initTermInput :: Int -> Terminal -> IO (IO Event, IO ())+initTermInput escDelay terminal = do eventChannel <- newChan inputChannel <- newChan+ hadInput <- newEmptyMVar oattr <- getTerminalAttributes stdInput let nattr = foldl withoutMode oattr [StartStopOutput, KeyboardInterrupts, EnableEcho, ProcessInput] setTerminalAttributes stdInput nattr Immediately set_term_timing- terminal <- setupTermFromEnv - let inputToEventThread :: IO ()- inputToEventThread = threadName "input_to_event" >> loop [] + inputToEventThread = loop [] where loop kb = case (classify kb) of Prefix -> do c <- readChan inputChannel loop (kb ++ [c]) Invalid -> loop "" MisPfx k m s -> writeChan eventChannel (EvKey k m) >> loop s Valid k m -> writeChan eventChannel (EvKey k m) >> loop ""++ finishAtomicInput = writeChan inputChannel '\xFFFE'+ inputThread :: IO ()- inputThread = threadName "input" >> loop+ inputThread = loop where loop = do setFdOption stdInput NonBlockingRead False threadWaitRead stdInput setFdOption stdInput NonBlockingRead True try readAll :: IO (Either IOException ())- writeChan inputChannel '\xFFFE'+ when (escDelay == 0) finishAtomicInput loop readAll = do (bytes, bytes_read) <- fdRead stdInput 1- if bytes_read > 0- then writeChan inputChannel (head bytes)- else return ()+ when (bytes_read > 0) $ do+ tryPutMVar hadInput () -- signal input+ writeChan inputChannel (head bytes) readAll- + -- | If there is no input for some time, this thread puts '\xFFFE' in the+ -- inputChannel. + noInputThread :: IO ()+ noInputThread = when (escDelay > 0) loop+ where loop = do+ takeMVar hadInput -- wait for some input+ threadDelay escDelay -- microseconds+ hadNoInput <- isEmptyMVar hadInput -- no input yet?+ when hadNoInput $ do+ finishAtomicInput+ loop+ + compile :: [[([Char],(Key,[Modifier]))]] -> [Char] -> KClass compile lst = cl' where lst' = concat lst@@ -99,7 +126,7 @@ classify, classifyTab :: [Char] -> KClass - classify "\xFFFD" = Invalid + -- As soon as classify "\xFFFE" = Invalid classify s@(c:_) | ord c >= 0xC2 = if utf8Length (ord c) > length s then Prefix else classifyUtf8 s -- beginning of an utf8 sequence@@ -170,14 +197,15 @@ eventThreadId <- forkIO $ inputToEventThread inputThreadId <- forkIO $ inputThread- let pokeIO = (Catch $ do threadName "winch|cont"- let e = error "(getsize in input layer)"+ noInputThreadId <- forkIO $ noInputThread+ let pokeIO = (Catch $ do let e = error "(getsize in input layer)" setTerminalAttributes stdInput nattr Immediately writeChan eventChannel (EvResize e e)) installHandler windowChange pokeIO Nothing installHandler continueProcess pokeIO Nothing let uninit = do killThread eventThreadId killThread inputThreadId+ killThread noInputThreadId installHandler windowChange Ignore Nothing installHandler continueProcess Ignore Nothing setTerminalAttributes stdInput oattr Immediately
+ Graphics/Vty/Output.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# CFILES gwinsz.c #-}+module Graphics.Vty.Output ( initTermOutput+ , clrscr+ , getwinsize+ , beep+ , flush+ , tputchar+ , chgatt+ , putShow+ )+ where++import Graphics.Vty.Types+import Graphics.Vty.ControlStrings++import Control.Monad ( when )+import Data.Bits ( (.|.), (.&.), shiftR )++import Foreign.C.Types ( CLong )++import System.Console.Terminfo+import System.IO ( stdout, hFlush )++-- | Set up the terminal for output, and create an object representing the+-- initial state. Also returns a function for shutting down the terminal access.+initTermOutput :: Terminal -> IO (TermState, IO ())+initTermOutput terminal = do + let cap_smcup = getCapability terminal $ tiGetStr "smcup"+ maybe (return ()) putStr cap_smcup+ putStr reset+ hFlush stdout+ return (TS 0 0 attr, uninitTermOutput terminal)++uninitTermOutput :: Terminal -> IO ()+uninitTermOutput terminal = do + (_,sy) <- getwinsize_+ putStr (endterm sy)+ let cap_rmcup = getCapability terminal $ tiGetStr "rmcup"+ maybe (return ()) putStr cap_rmcup+ hFlush stdout++-- | Force sent commands to be respected.+flush :: TermState -> IO TermState+flush ts = hFlush stdout >> return ts++-- | Reset the screen.+clrscr :: TermState -> IO TermState+clrscr _ts = do putStr reset+ return (TS 0 0 attr)++-- ANSI specific bits+chgatt :: Attr -> IO ()+chgatt (Attr bf)+ = putStr "\ESC[0;" >>+ putShow (bf .&. 0xFF) >> + putStr ";" >> putShow ((bf `shiftR` 8) .&. 0xFF) >> + 0x10000 ? ";1" >>+ 0x20000 ? ";5" >> 0x40000 ? ";7" >> 0x80000 ? ";2" >> 0x100000 ? ";4" >> + putStr "m"+ where+ {-# INLINE (?) #-}+ (?) :: Int -> [Char] -> IO ()+ field ? x | bf .&. field == 0 = return ()+ | otherwise = putStr x++tputchar :: Char -> IO ()+tputchar ch | ich < 0x80 = pch ich+ | ich < 0x800 = pch (0xC0 .|. (ich `usr` 6)) >> pch (0x80 .|. (0x3F .&. ich))+ | ich < 0x10000 = pch (0xE0 .|. (ich `usr` 12)) >> pch (0x80 .|. (0x3F .&. (ich `usr` 6))) >>+ pch (0x80 .|. (0x3F .&. ich))+ | otherwise = pch (0xF0 .|. (ich `usr` 24)) >> pch (0x80 .|. (0x3F .&. (ich `usr` 12))) >>+ pch (0x80 .|. (0x3F .&. (ich `usr` 6))) >> pch (0x80 .|. (0x3F .&. ich))+ where ich = fromEnum ch+ pch = putChar . toEnum+ usr = shiftR++putShow :: Int -> IO ()+putShow n = when (ini /= 0) (putShow ini) >> putChar (toEnum (lst + 48))+ where (ini, lst) = divMod n 10+-- {-# INLINE putShow #-}++foreign import ccall "gwinsz.h c_get_window_size" c_get_window_size :: IO CLong+getwinsize_ :: IO (Int,Int)+getwinsize_ = do (a,b) <- (`divMod` 65536) `fmap` c_get_window_size+ return (fromIntegral b, fromIntegral a)+getwinsize :: TermState -> IO ((Int,Int), TermState)+getwinsize ts = do (a,b) <- (`divMod` 65536) `fmap` c_get_window_size+ return ((fromIntegral b, fromIntegral a), ts)++reset :: String+reset = -- "\ESCc" ++ -- full reset+ utf8CharSet ++ + setCursorPosition 1 1 +++ "\ESC[2J" -- erase all++-- | Make the terminal beep.+beep :: IO ()+beep = putStr "\BEL" ++-- | Restore the terminal to a good state for the shell.+-- Parameter is the line where the cursor should appear.+endterm :: Int -> [Char]+endterm sy = setCursorPosition sy 1 +++ "\ESC[0;39;49m" ++ -- graphic rendition+ defaultCharSet ++ + "\CR" ++ + cvis +++ "\ESC[K" -- erase line++defaultCharSet, utf8CharSet :: String+defaultCharSet = "\ESC%@"+utf8CharSet = "\ESC%G"+
Graphics/Vty/Types.hs view
@@ -1,4 +1,5 @@-module Graphics.Vty.Types where+module Graphics.Vty.Types + where import Data.Bits( (.&.), (.|.), shiftL ) @@ -14,6 +15,9 @@ -- |This type represents the visible cursor state. data Cursor = NoCursor -- ^ Hide the cursor. | Cursor Int Int -- ^ Display the cursor at the given XY position.++-- | An object representing the current state of the terminal.+data TermState = TS {_tsRow :: !Int, _tsColumn :: !Int, _tsAttr :: !Attr} -- Gah. GHC can't unbox bitfields itself :(
vty.cabal view
@@ -1,5 +1,5 @@ Name: vty-Version: 3.1.6+Version: 3.1.8 License: BSD3 License-file: LICENSE Author: Stefan O'Rear@@ -33,7 +33,11 @@ cbits/set_term_timing.c Include-Dirs: cbits Install-Includes: gwinsz.h-Other-Modules: Graphics.Vty.Types, Graphics.Vty.Cursor, Graphics.Vty.LLInput+Other-Modules: Graphics.Vty.Types+ Graphics.Vty.Cursor+ Graphics.Vty.LLInput+ Graphics.Vty.Output+ Graphics.Vty.ControlStrings ghc-options: -funbox-strict-fields -Wall -threaded ghc-prof-options: -funbox-strict-fields -auto-all -Wall -threaded