1 files changed, 67 insertions, 0 deletions

diff --git a/Presence/FGConsole.hs b/Presence/FGConsole.hs
new file mode 100644
index 00000000..03aaebf2
--- /dev/null
+++ b/Presence/FGConsole.hs
@@ -0,0 +1,67 @@
+{-# 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
+
+import Logging
+import System.Posix.Signals
+
+-- c_monitorTTY fd = trace "c_monitorTTY" (return ()) -- (trace "WTF" todo)
+
+foreign import ccall "monitorTTY" c_monitorTTY :: Fd -> IO CInt
+foreign import ccall "closeTTY" c_closeTTY :: IO ()
+
+forkTTYMonitor :: (Word8 -> IO ()) -> IO (Maybe (Fd,ThreadId))
+forkTTYMonitor handler =  do
+    (rfd,wfd) <- createPipe
+    retvar <- newEmptyMVar
+    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
+        didfork <- c_monitorTTY wfd
+        putMVar retvar didfork
+        when (didfork == 0) $ do
+        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
+    didfork <- takeMVar retvar
+    if didfork == 0
+        then return $! Just (rfd,thread)
+        else return $! Nothing
+
+killTTYMonitor :: (Fd, ThreadId) -> IO ()
+killTTYMonitor (rfd,thread) = do
+    closeFd rfd
+    yield
+    killThread thread
+    raiseSignal sigUSR1
+    -- threadDelay 1000000
+
+
+-- vim:ft=haskell: