summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Benjamin Barenblat <bbaren@mit.edu>2015-05-27 22:16:42 -0400
committerGravatar Benjamin Barenblat <bbaren@mit.edu>2015-05-27 22:16:42 -0400
commit3b18966e69777c1c1f647899435df9fa1103918d (patch)
tree79646321ca10c59784c244b978f6f83d61e249bb
parentd95da762bdf5dacf01a2778e3f3ded2b4e464a49 (diff)
Make producers write to an IORef instead of an MSampleVar
Since neither reads nor writes to these variables should block, and since all races are benign, MSampleVar actually has incorrect semantics. A simple IORef is the correct data structure to use.
-rw-r--r--src/Main.hs17
1 files changed, 9 insertions, 8 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 6e7496b..2c61a3b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -20,6 +20,7 @@ import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.MSampleVar
import Control.Monad (forever, void)
import Data.Default.Class (def)
+import Data.IORef
import Graphics.Vty (Vty)
import qualified Graphics.Vty as Vty
@@ -35,38 +36,38 @@ initialize _ = return ()
jarvis :: Vty -> IO ()
jarvis terminal = do
- log <- newSV Vty.emptyImage
- prompt <- newSV Vty.emptyImage
+ log <- newIORef Vty.emptyImage
+ prompt <- newIORef Vty.emptyImage
ready <- newEmptySV
void $ forkIO $ redrawer ready log prompt terminal
void $ forkIO $ prompter prompt ready
void $ forkIO $ logger log ready
void $ Vty.nextEvent terminal
-prompter :: MSampleVar Vty.Image -> MSampleVar () -> IO ()
+prompter :: IORef Vty.Image -> MSampleVar () -> IO ()
prompter output redraw = prompt' 0
where prompt' :: Integer -> IO ()
prompt' n = do
- writeSV output $ Vty.string def ("jarvis " ++ show n ++ " >")
+ writeIORef output $ Vty.string def ("jarvis " ++ show n ++ " >")
writeSV redraw ()
threadDelay 1000000
prompt' (n + 1)
-logger :: MSampleVar Vty.Image -> MSampleVar () -> IO ()
+logger :: IORef Vty.Image -> MSampleVar () -> IO ()
logger output redraw = log 0 []
where log :: Integer -> [String] -> IO ()
log n lines = do
let lines' = lines ++ ["<" ++ show n ++ ">"]
- writeSV output $ Vty.vertCat $ map (Vty.string def) lines'
+ writeIORef output $ Vty.vertCat $ map (Vty.string def) lines'
writeSV redraw ()
threadDelay 200000
log (n + 1) lines'
-redrawer :: MSampleVar () -> MSampleVar Vty.Image -> MSampleVar Vty.Image -> Vty -> IO ()
+redrawer :: MSampleVar () -> IORef Vty.Image -> IORef Vty.Image -> Vty -> IO ()
redrawer ready log prompt terminal = forever $ do
void $ readSV ready
(_maxX, maxY) <- Vty.displayBounds $ Vty.outputIface terminal
- images <- sequence $ map readSV [log, prompt]
+ images <- sequence $ map readIORef [log, prompt]
let stack = resizeHeight' maxY $ Vty.vertCat images
Vty.update terminal $ Vty.picForImage stack
Vty.refresh terminal