Matti Niemenmaa 쓴 글:
Bulat Ziganshin wrote:
1. works for me in ghc:
getHiddenChar = liftM (chr.fromEnum) c_getch
foreign import ccall unsafe "conio.h getch"
c_getch :: IO CInt
Thanks to Bulat, Bayley, and Matti for suggestions and discussions.
At least for my purpose of running the particular example I had "conio.h
getch" is good enough because the entire example only depends on the
getCh for its input.
I defined getCh as follows and it seems to works OK on windows cmd.
\begin{code}
{-# LANGUAGE ForeignFunctionInterface#-}
import Monad
import Char
import Foreign.C
getCh = liftM (chr . fromEnum) c_getch
foreign import ccall "conio.h getch" c_getch :: IO CInt
\end{code}
Just want to make a comment that this "conio.h getch" will only work on
windows cmd but not on linux terminals. Both on ghc 6.8.2 and ghc
6.10.1 throws an error when I try to do getCh
[EMAIL PROTECTED]:~/MyDoc$ ghci-6.8.2 Main
GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help
Loading package base ... linking ... done.
[1 of 1] Compiling Main ( Main.hs, interpreted )
Ok, modules loaded: Main.
*Main> getCh
*** Exception: Prelude.chr: bad argument
I hope we can have more portable way of handling command line buffering
in the future releases GHC.
Thanks, for you all again.
Depending on your use case, that's an okay workaround. (And probably suitable
for the OP as well.)
But unfortunately conio doesn't mix well with ordinary IO. For one, it always
reads from the console and not stdin, so redirecting stdin won't work. Another
problem is illustrated in the following:
main = do
a <- getChar
b <- getHiddenChar
c <- getChar
print a
print b
print c
Type a, then press enter, then b. The result (including the echoed input):
a
'a'
'b'
'\n'
I don't know where that '\n' came from but it certainly shouldn't be there.
Yet another example: type abcd, then press enter, giving:
abcd
'a'
'\r'
'b'
The fact that newlines are reported as '\r' and not '\n' is easy enough to deal
with, but I wonder why getch chose to give '\r' and not 'b'?
_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users