1 files changed, 20 insertions, 0 deletions

diff --git a/examples/atox.hs b/examples/atox.hs
index 561e85f9..7845d911 100644
--- a/examples/atox.hs
+++ b/examples/atox.hs
@@ -15,6 +15,8 @@ import qualified Data.Conduit.Binary as Conduit
 import Data.Conduit.Cereal
 import Data.Function
 import qualified Data.Map.Strict as Map
+import qualified Data.Sequence as Seq
+import Data.Sequence (Seq(..),(|>))
 import Data.Monoid
 import qualified Data.Serialize as S
 import Data.Serialize (Get(..), Put(..))
@@ -54,6 +56,10 @@ sThem = unsafePerformIO $ newTVarIO zero
 sMap :: TVar (Map.Map Key ViewSnapshot)
 sMap = unsafePerformIO $ newTVarIO (Map.empty)
 
+{-# NOINLINE sScroll #-}
+sScroll :: TVar (Map.Map Key (Seq CryptoMessage))
+sScroll = unsafePerformIO $ newTVarIO (Map.empty)
+
 -----------------------
 
 
@@ -82,6 +88,7 @@ pattern IPC = Padding
 data SetCmd = SetME
             | SetTHEM
             | SetView
+            | AppendMsg
     deriving (Eq,Bounded,Ord,Enum,Show)
 
 forkToxInputThread myRead = forkIO $ do
@@ -105,6 +112,19 @@ forkToxInputThread myRead = forkIO $ do
                                     let key = Key me them
                                     modifyTVar' sMap (Map.insert key view)
 
+    updateState AppendMsg arg
+             = case S.decode arg of
+                 Left str  -> puts (packUtf8 str)
+                 Right msg -> liftIO . atomically $ do
+                                me <- readTVar sMe
+                                them <- readTVar sThem
+                                let key = Key me them
+                                scroll <- readTVar sScroll
+                                let mbCurrentMsgs = Map.lookup key scroll
+                                case mbCurrentMsgs of
+                                    Nothing -> modifyTVar' sScroll (Map.insert key (Seq.singleton msg))
+                                    Just history -> modifyTVar' sScroll (Map.insert key (history |> msg))
+
 doit :: Fd -> Fd -> IO ()
 doit myReadFd myWriteFd = do
     myRead <- fdToHandle myReadFd