Commit 060646 updates

1 file Authored and Committed by Richard Marko 2 years ago
updates

    
 1 @@ -29,7 +29,11 @@
 2   
 3   toSerial q h = forever $ do
 4     x <- atomically $ readTBQueue q
 5 -   hPutStr h x
 6 +   case tail x of
 7 +     "\n" -> hPutStr h x
 8 +     _ -> hPutStrLn h x
 9 +   --threadDelay 100 -- 0000
10 +   threadDelay 1000000
11   
12   --  x <- atomically $ tryReadTBQueue q
13   --  case x of
14 @@ -50,16 +54,33 @@
15     x <- atomically $ readTBQueue q
16     putChar x
17   
18 - run qI qO h = do
19 + fromStdin q = do
20 +   e <- isEOF
21 +   if e
22 +     then return ()
23 +     else do
24 +             c <- getLine
25 +             atomically $ writeTQueue q c
26 +             fromStdin q
27 + 
28 + run qI qO qC h = do
29     runConcurrently $    Concurrently (toSerial qI h)
30                       *> Concurrently (fromSerial qO h)
31                       *> Concurrently (toStdout qO)
32 +                     *> Concurrently (fromStdin qC)
33 +                     *> Concurrently (lopata qC qI)
34 + 
35 + lopata qC qI = forever $ do
36 +   x <- atomically $ readTQueue qC
37 +   atomically $ writeTBQueue qI x
38   
39   main :: IO ()
40   main = do
41 -   sIn <- atomically $ newTBQueue 1000
42 +   sIn <- atomically $ newTBQueue 1-- 000
43     sOut <- atomically $ newTBQueue 10000
44   
45 -   atomically $ writeTBQueue sIn ""
46 -   mapM_ (\x -> atomically $ writeTBQueue sIn "version\n") [0..900]
47 -   bracket (hOpenSerial "/dev/ttyACM0" settings) hClose (run sIn sOut)
48 +   qC <- atomically $ newTQueue
49 + 
50 +   --atomically $ writeTBQueue sIn ""
51 +   --mapM_ (\x -> atomically $ writeTBQueue sIn "version\n") [0..900]
52 +   bracket (hOpenSerial "/dev/ttyACM0" settings) hClose (run sIn sOut qC)