-- Copyright 2009-2010 Corey O'Connor{-# OPTIONS_GHC -Wall #-}{-# LANGUAGE ForeignFunctionInterface #-}moduleGraphics.Vty.LLInput(Key(..),Modifier(..),Button(..),Event(..),initTermInput)whereimportData.CharimportData.Maybe(mapMaybe)importData.List(inits)importData.WordimportqualifiedData.MapasM(fromList,lookup)importqualifiedData.SetasS(fromList,member)importCodec.Binary.UTF8.Generic(decode)importControl.Monad(when)importControl.ConcurrentimportControl.ExceptionimportSystem.Console.TerminfoimportSystem.Posix.Signals.ExtsimportSystem.Posix.TerminalimportSystem.Posix.IO(stdInput,fdRead,setFdOption,FdOption(..))-- |Representations of non-modifier keys.dataKey=KEsc|KFunInt|KBackTab|KPrtScr|KPause|KASCIIChar|KBS|KIns|KHome|KPageUp|KDel|KEnd|KPageDown|KBegin|KNP5|KUp|KMenu|KLeft|KDown|KRight|KEnterderiving(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.dataModifier=MShift|MCtrl|MMeta|MAltderiving(Eq,Show,Ord)-- |Mouse buttons. Not yet used.dataButton=BLeft|BMiddle|BRightderiving(Eq,Show,Ord)-- |Generic events.dataEvent=EvKeyKey[Modifier]|EvMouseIntIntButton[Modifier]|EvResizeIntIntderiving(Eq,Show,Ord)dataKClass=ValidKey[Modifier]|Invalid|Prefix|MisPfxKey[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::Int->Terminal->IO(IOEvent,IO())initTermInputescDelayterminal=doeventChannel<-newChaninputChannel<-newChanhadInput<-newEmptyMVaroattr<-getTerminalAttributesstdInputletnattr=foldlwithoutModeoattr[StartStopOutput,KeyboardInterrupts,EnableEcho,ProcessInput,ExtendedFunctions]setTerminalAttributesstdInputnattrImmediatelyset_term_timingletinputToEventThread::IO()inputToEventThread=loop[]whereloopkb=case(classifykb)ofPrefix->doc<-readChaninputChannelloop(kb++[c])Invalid->loop""MisPfxkms->writeChaneventChannel(EvKeykm)>>loopsValidkm->writeChaneventChannel(EvKeykm)>>loop""finishAtomicInput=writeChaninputChannel'\xFFFE'inputThread::IO()inputThread=loopwhereloop=dosetFdOptionstdInputNonBlockingReadFalsethreadWaitReadstdInputsetFdOptionstdInputNonBlockingReadTrue_<-tryreadAll::IO(EitherIOException())when(escDelay==0)finishAtomicInputloopreadAll=do(bytes,bytes_read)<-fdReadstdInput1when(bytes_read>0)$do_<-tryPutMVarhadInput()-- signal inputwriteChaninputChannel(headbytes)readAll-- | If there is no input for some time, this thread puts '\xFFFE' in the-- inputChannel. noInputThread::IO()noInputThread=when(escDelay>0)loopwhereloop=dotakeMVarhadInput-- wait for some inputthreadDelayescDelay-- microsecondshadNoInput<-isEmptyMVarhadInput-- no input yet?whenhadNoInput$dofinishAtomicInputloopcompile::[[([Char],(Key,[Modifier]))]]->[Char]->KClasscompilelst=cl'wherelst'=concatlstpfx=S.fromList$concatMap(init.inits.fst)$lst'mlst=M.fromListlst'cl'str=caseS.memberstrpfxofTrue->PrefixFalse->caseM.lookupstrmlstofJust(k,m)->ValidkmNothing->casehead$mapMaybe(\s->(,)s`fmap`M.lookupsmlst)$init$initsstrof(s,(k,m))->MisPfxkm(drop(lengths)str)-- ANSI specific bitsclassify,classifyTab::[Char]->KClass-- As soon asclassify"\xFFFE"=Invalidclassifys@(c:_)|ordc>=0xC2=ifutf8Length(ordc)>lengthsthenPrefixelseclassifyUtf8s-- beginning of an utf8 sequenceclassifyother=classifyTabotherclassifyUtf8s=casedecode((map(fromIntegral.ord)s)::[Word8])ofJust(unicodeChar,_)->Valid(KASCIIunicodeChar)[]_->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)|(Justx,y)<-map(first(getCapabilityterminal.tiGetStr))$caps_tabls]ansi_classify_table::[[([Char],(Key,[Modifier]))]]ansi_classify_table=[letkcs=("\ESC["++c,(s,[]))in[k"G"KNP5,k"P"KPause,k"A"KUp,k"B"KDown,k"C"KRight,k"D"KLeft,k"H"KHome,k"F"KEnd,k"E"KBegin],-- Support for arrows[("\ESC["++charCnt++showmc++c,(s,m))|charCnt<-["1;",""],-- we can have a count or not(m,mc)<-[([MShift],2::Int),([MCtrl],5),([MMeta],3),([MShift,MCtrl],6),([MShift,MMeta],4)],-- modifiers and their codes(c,s)<-[("A",KUp),("B",KDown),("C",KRight),("D",KLeft)]-- directions and their codes],letkns=("\ESC["++shown++"~",(s,[]))inzipWithk[2::Int,3,5,6,1,4][KIns,KDel,KPageUp,KPageDown,KHome,KEnd],-- Support for simple characters.[(x:[],(KASCIIx,[]))|x<-maptoEnum[0..255]],-- Support for function keys (should use terminfo)[("\ESC[["++[toEnum(64+i)],(KFuni,[]))|i<-[1..5]],letfffnrsm=[("\ESC["++shown++"~",(KFun(n-(nrs!!0)+ff),m))|n<-nrs]inconcat[f6[17..21][],f11[23,24][],f1[25,26][MShift],f3[28,29][MShift],f5[31..34][MShift]],[('\ESC':[x],(KASCIIx,[MMeta]))|x<-'\ESC':'\t':[' '..'\DEL']],-- Ctrl+Char[([toEnumx],(KASCIIy,[MCtrl]))|(x,y)<-zip([0..31])('@':['a'..'z']++['['..'_']),y/='i'-- Resolve issue #3 where CTRL-i hides TAB.],-- Ctrl+Meta+Char[('\ESC':[toEnumx],(KASCIIy,[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,[]))]]eventThreadId<-forkIO$inputToEventThreadinputThreadId<-forkIO$inputThreadnoInputThreadId<-forkIO$noInputThreadletpokeIO=(Catch$dolete=error"(getsize in input layer)"setTerminalAttributesstdInputnattrImmediatelywriteChaneventChannel(EvResizeee))_<-installHandlerwindowChangepokeIONothing_<-installHandlercontinueProcesspokeIONothingletuninit=dokillThreadeventThreadIdkillThreadinputThreadIdkillThreadnoInputThreadId_<-installHandlerwindowChangeIgnoreNothing_<-installHandlercontinueProcessIgnoreNothingsetTerminalAttributesstdInputoattrImmediatelyreturn(readChaneventChannel,uninit)first::(a->b)->(a,c)->(b,c)firstf(x,y)=(fx,y)utf8Length::(Numt,Orda,Numa)=>a->tutf8Lengthc|c<0x80=1|c<0xE0=2|c<0xF0=3|otherwise=4foreignimportccall"set_term_timing"set_term_timing::IO()