packages feed

vty 3.0.2 → 3.0.4

raw patch · 4 files changed

+140/−61 lines, 4 filesdep +terminfodep +utf8-string

Dependencies added: terminfo, utf8-string

Files

Graphics/Vty.hs view
@@ -41,8 +41,10 @@  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)) - rec = Vty { update = update' , getEvent = gkey , getSize = ulift getwinsize ,-             shutdown = fend }+ rec = Vty { update = update' +           , getEvent = gkey+           , getSize = ulift getwinsize+           , shutdown = fend }   update' (Pic nc (T.Image wr w h)) = modifyMVar_ rstate $ \(ts0, fbw, fbh, oldptr) -> do    (shd,ts1) <- case (fbw,fbh) == (w,h) of
Graphics/Vty/Cursor.hs view
@@ -130,6 +130,12 @@ reset = "\ESCc\ESC%G\ESC[1;1H\ESC[2J" -- | Make the terminal beep. beep :: IO ()-beep = putStr "\BEL" ; cvis = "\ESC[?25h" ; civis = "\ESC[?25l"+beep = putStr "\BEL" +-- | Show the cursor+cvis = "\ESC[?25h" +civis = "\ESC[?25l" endterm :: Int -> [Char]-endterm sy = "\ESC[" ++ show sy ++ ";1H\ESC[0;39;49m\ESC%@\CR\ESC[?25h\ESC[K"+endterm sy = "\ESC[" ++ show sy ++ ";1H\ESC[0;39;49m" +++             "\ESC%@\CR" ++ -- select default charset (\ESC%G would select UTF8)+             cvis +++             "\ESC[K"
Graphics/Vty/LLInput.hs view
@@ -2,20 +2,25 @@ module Graphics.Vty.LLInput     ( Key(..), Modifier(..), Button(..), Event(..), initTermInput ) where +import Data.Char import Data.Maybe( mapMaybe ) import Data.List( inits )+import Data.Word import qualified Data.Map as M( fromList, lookup ) import qualified Data.Set as S( fromList, member ) +import Codec.Binary.UTF8.Generic (decode)+ import Control.Concurrent 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(..))  -- |Representations of non-modifier keys.-data Key = KEsc | KFun Int | KPrtScr | KPause | KASCII Char | KBS | KIns+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) -- |Modifier keys.  Key codes are interpreted such that users are more likely to@@ -46,6 +51,115 @@   let nattr = foldl withoutMode oattr [StartStopOutput, KeyboardInterrupts,                                        EnableEcho, ProcessInput]   setTerminalAttributes stdInput nattr Immediately+  terminal <- setupTermFromEnv ++  let iothread :: MVar Event -> IO ()+      iothread chn = threadName "kbd" >> loop [] where+          loop kb = case (classify kb) of+                      Prefix       -> do ch <- getInput+                                         loop (kb ++ [ch])+                      Invalid      -> loop ""+                      MisPfx k m s -> putMVar chn (EvKey k m) >> loop s+                      Valid k m    -> putMVar chn (EvKey k m) >> loop ""+          getInput = do +              catch +                  (do+                      setFdOption stdInput NonBlockingRead True+                      (bytes, bytes_read) <- fdRead stdInput 1 +                      if (bytes_read > 0)+                          then return (head bytes)+                          else do+                              threadDelay 50000+                              return '\xFFFE'+                  )+                  (\_ -> do+                      threadDelay 50000+                      return '\xFFFE')+      +      compile :: [[([Char],(Key,[Modifier]))]] -> [Char] -> KClass+      compile lst = cl' where+          lst' = concat lst+          pfx = S.fromList $ concatMap (init . inits . fst) $ lst'+          mlst = M.fromList lst'+          cl' str = case S.member str pfx of+                      True -> Prefix+                      False -> case M.lookup str mlst of+                                 Just (k,m) -> Valid k m+                                 Nothing -> case head $ mapMaybe (\s -> (,) s `fmap` M.lookup s mlst) $ init $ inits str of+                                              (s,(k,m)) -> MisPfx k m (drop (length s) str)+      +      -- ANSI specific bits+++      classify, classifyTab :: [Char] -> KClass+      +      classify "\xFFFD" = Invalid +      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+      classify other = classifyTab other++      classifyUtf8 s = case decode ((map (fromIntegral . ord) s) :: [Word8]) of+          Just (unicodeChar, _) -> Valid (KASCII unicodeChar) []+          _ -> Invalid -- something bad happened; just ignore and continue.+         +      classifyTab = compile (caps_classify_table : ansi_classify_table)+   +      caps_tabls = [("khome", (KHome, [])), +                    ("kend",  (KEnd,  [])),+                    ("cbt",   (KBackTab, [])),+                    ("kcud1", (KDown,  [])),+                    ("kcuu1", (KUp,  [])),+                    ("kcuf1", (KRight,  [])),+                    ("kcub1", (KLeft,  [])),++                    ("kLFT", (KLeft, [MShift])),+                    ("kRIT", (KRight, [MShift]))+                   ]+   +      caps_classify_table = [(x,y) | (Just x,y) <- map (first (getCapability terminal . tiGetStr)) $ caps_tabls]+      +      ansi_classify_table :: [[([Char], (Key, [Modifier]))]]+      ansi_classify_table =+         [ let k c s = ("\ESC["++c,(s,[])) in [ k "G" KNP5, k "P" KPause,  k "A" KUp, k "B" KDown, k "C" KRight, k "D" KLeft ],++           -- Support for arrows+           let k c s = [("\ESC[1;"++show mc++c,(s,m)) | (m,mc) <- +                        [([MShift],2::Int), ([MCtrl],5), ([MMeta],3), +                         ([MShift, MCtrl],6), ([MShift, MMeta],4)]]+               in concat [ k "A" KUp, k "B" KDown, k "C" KRight, k "D" KLeft ],++           let k n s = ("\ESC["++show n++"~",(s,[])) in zipWith k [2::Int,3,5,6] [KIns,KDel,KPageUp,KPageDown],++           -- Support for simple characters.+           [ (x:[],(KASCII x,[])) | x <- map toEnum [0..255] ],++           -- Support for function keys (should use terminfo)+           [ ("\ESC[["++[toEnum(64+i)],(KFun i,[])) | i <- [1..5] ],+           let f ff nrs m = [ ("\ESC["++show n++"~",(KFun (n-(nrs!!0)+ff), m)) | n <- nrs ] in+           concat [ f 6 [17..21] [], f 11 [23,24] [], f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ],+           [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\ESC':'\t':[' ' .. '\DEL'] ],++           -- Ctrl+Char+           [ ([toEnum x],(KASCII y,[MCtrl])) +              | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_']),+                y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.+           ],+           +           -- Ctrl+Meta+Char+           [ ('\ESC':[toEnum x],(KASCII y,[MMeta,MCtrl])) | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_']) ],++           -- Special support+           [ -- special support for ESC +             ("\ESC",(KEsc,[])) , ("\ESC\ESC",(KEsc,[MMeta])), ++             -- Special support for backspace+             ("\DEL",(KBS,[])), ("\ESC\DEL",(KBS,[MMeta])),+             +             -- Special support for Enter+             ("\ESC\^J",(KEnter,[MMeta])), ("\^J",(KEnter,[])) ] +         ]+      iothr <- forkIO $ iothread kchan   let pokeIO = (Catch $ do threadName "winch|cont"                            let e = error "(getsize in input layer)"@@ -59,60 +173,13 @@                   setTerminalAttributes stdInput oattr Immediately   return (takeMVar kchan, uninit) -iothread :: MVar Event -> IO ()-iothread chn = threadName "kbd" >> loop [] where-    loop kb = case (classify kb) of-                Prefix       -> do ch <- getInput-                                   loop (kb ++ [ch])-                Invalid      -> loop ""-                MisPfx k m s -> putMVar chn (EvKey k m) >> loop s-                Valid k m    -> putMVar chn (EvKey k m) >> loop ""-    getInput = do -        catch -            (do-                setFdOption stdInput NonBlockingRead True-                (bytes, bytes_read) <- fdRead stdInput 1 -                if (bytes_read > 0)-                    then do-                        let out_byte = head bytes-                        return (head bytes)-                    else do-                        threadDelay 50000-                        return '\xFFFE'-            )-            (\_ -> do-                threadDelay 50000-                return '\xFFFE')--compile :: [[([Char],(Key,[Modifier]))]] -> [Char] -> KClass-compile lst = cl' where-    lst' = concat lst-    pfx = S.fromList $ concatMap (init . inits . fst) $ lst'-    mlst = M.fromList lst'-    cl' "\xFFFD" = Invalid ; cl' "\xFFFE" = Invalid-    cl' str = case S.member str pfx of-                True -> Prefix-                False -> case M.lookup str mlst of-                           Just (k,m) -> Valid k m-                           Nothing -> case head $ mapMaybe (\s -> (,) s `fmap` M.lookup s mlst) $ init $ inits str of-                                        (s,(k,m)) -> MisPfx k m (drop (length s) str)---- ANSI specific bits--classify :: [Char] -> KClass-classify = compile ansi_classify_table+first :: (a -> b) -> (a,c) -> (b,c)+first f (x,y) = (f x, y) -ansi_classify_table =-   [ let k c s = ("\ESC["++c,(s,[])) in-     [ k "A" KUp, k "B" KDown, k "C" KRight, k "D" KLeft, k "G" KNP5, k "P" KPause ],-     let k n s = ("\ESC["++show n++"~",(s,[])) in zipWith k [1::Int ..6] [KHome,KIns,KDel,KEnd,KPageUp,KPageDown],-     [ (x:[],(KASCII x,[])) | x <- map toEnum [0..255] ],-     [ ("\ESC[["++[toEnum(64+i)],(KFun i,[])) | i <- [1..5] ],-     let f ff nrs m = [ ("\ESC["++show n++"~",(KFun (n-(nrs!!0)+ff), m)) | n <- nrs ] in-     concat [ f 6 [17..21] [], f 11 [23,24] [], f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ],-     [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\ESC':'\t':[' ' .. '\DEL'] ],-     [ ([toEnum x],(KASCII y,[MCtrl])) | (x,y) <- zip ([0..8] ++ [10..31]) ('@':['a'..'h'] ++ ['j'..'z']++['['..'_']) ],-     [ ('\ESC':[toEnum x],(KASCII y,[MMeta,MCtrl])) | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_']) ],-     [ ("\ESC",(KEsc,[])) , ("\ESC\ESC",(KEsc,[MMeta])) , ("\DEL",(KBS,[])), ("\ESC\DEL",(KBS,[MMeta])),-       ("\ESC\^J",(KEnter,[MMeta])), ("\^J",(KEnter,[])) ] ]+utf8Length :: (Num t, Ord a, Num a) => a -> t+utf8Length c +    | c < 0x80 = 1+    | c < 0xE0 = 2+    | c < 0xF0 = 3+    | otherwise = 4
vty.cabal view
@@ -1,9 +1,10 @@ Name:                vty-Version:             3.0.2+Version:             3.0.4 License:             BSD3 License-file:        LICENSE Author:              Stefan O'Rear Maintainer:          Corey O'Connor (coreyoconnor@gmail.com)+Homepage:            http://trac.haskell.org/vty/ Category:            User Interfaces Synopsis:            A simple terminal access library Description:@@ -17,9 +18,12 @@                         requires Linux\/xterm style UTF8 support.   .   You can 'darcs get' it from <http://code.haskell.org/vty/>+  '   &#169; 2006-2007 Stefan O'Rear; BSD3 license.  Build-Depends:       base>3, bytestring, containers, unix+Build-Depends:       terminfo >= 0.2 && < 0.3+Build-Depends:       utf8-string >= 0.3 && < 0.4 Build-Type:          Simple Data-Files:          README, TODO Extra-Source-Files:  test/Test.hs, cbits/gwinsz.h, test/Bench.hs