[Haskell-cafe] Re: Trapping getChar before echo

Andrew Coppin andrewcoppin at btinternet.com
Fri Feb 5 13:41:25 EST 2010


Tim Attwood wrote:
>> Last time I tried something like this [on Windows], it didn't seem to 
>> work. I wanted to trap arrow keys and so forth, but they seem to be 
>> being used for input history. (I.e., pressing the up-arrow produces 
>> previously-entered lines of text, and none of this appears to be 
>> reaching the Haskell program itself.) Has this changed since I tried 
>> it last year?
>
> Doesn't work in windows, at least up till 6.10.1. There's a 
> work-around though.
>
> {-# LANGUAGE ForeignFunctionInterface #-}
>
> import Data.Char
> import Control.Monad (liftM, forever)
> import Foreign.C.Types
>
> getHiddenChar = liftM (chr.fromEnum) c_getch
> foreign import ccall unsafe "conio.h getch"
>  c_getch :: IO CInt
>
> main = do
>   forever $ do
>      c <- getHiddenChar
>      putStrLn $ show (fromEnum c)

Thanks for the info.

Does anyone know how this is related to the "haskeline" package on Hackage?



More information about the Haskell-Cafe mailing list