1 files changed, 62 insertions, 0 deletions

diff --git a/Presence/FGConsole.hs b/Presence/FGConsole.hs
new file mode 100644
index 00000000..623fb493
--- /dev/null
+++ b/Presence/FGConsole.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module FGConsole where
+
+import Data.Word
+import System.Posix.IO
+import System.Posix.Types
+import Control.Concurrent
+-- import GHC.IO.Handle
+import Unsafe.Coerce
+import Control.Exception as E
+-- import Prelude as E
+import Control.Monad
+import Foreign.C.Error
+import Foreign.C
+
+import Logging
+import System.Posix.Signals
+
+-- c_monitorTTY fd = trace "c_monitorTTY" (return ()) -- (trace "WTF" todo)
+
+foreign import ccall "monitorTTY" c_monitorTTY :: Fd -> IO ()
+foreign import ccall "closeTTY" c_closeTTY :: IO ()
+
+monitorTTY :: (Word8 -> IO ()) -> IO (Fd,ThreadId)
+monitorTTY handler =  do
+    (rfd,wfd) <- createPipe
+    thread <- forkIO $ do
+        let cleanup = do
+                trace "quitting monitorTTY thread." (return ())
+                closeFd wfd `E.catch` \(e::IOException) -> return ()
+                closeFd rfd `E.catch` \(e::IOException) -> return ()
+                c_closeTTY
+        -- rh <- fdToHandle rfd
+        c_monitorTTY wfd
+        let monitor = 
+                (do
+                    threadWaitRead rfd
+                    (cs,cnt) <- fdRead rfd 1
+                    forM_ cs (handler . unsafeCoerce {- . trace "read byte" -})
+                    monitor)
+                `E.catch`
+                      \(e :: IOException) -> do
+                        err <- getErrno
+                        case () of
+                         _ | err==eAGAIN -> monitor
+                         _ | otherwise   -> cleanup
+                `E.catch` 
+                      \(e ::  AsyncException) -> cleanup
+        monitor
+    return (rfd,thread)
+
+unmonitorTTY :: (Fd, ThreadId) -> IO ()
+unmonitorTTY (rfd,thread) = do
+    closeFd rfd
+    yield
+    killThread thread
+    raiseSignal sigUSR1
+    -- threadDelay 1000000
+
+
+-- vim:ft=haskell: