\begin{code}
module Main where
import FranTk
import IO
import Concurrent
import Monad

prnt s = putStrLn s >> hFlush stdout
prntG s = liftIO $ prnt s

main = display $ withRootWindow [] $ do
 bv <- mkBVar "stopped"
 call <- mkGUIL_ $ callCalc (input bv)
 above (mkButton [text "start"] call)
       (mkLabel [textB $ bvarBehavior bv]) 

 

callCalc :: Listener String -> GUI ()
callCalc l = do
 cvar <- liftIO newChan
 let disp x = do when (x `mod` 1000 == 0) $ do
		   writeChan cvar ("Now="++show x)
	 	 when (x `mod` 100 == 0) $ yield
                 prnt (show x)
 let loop = mapM disp [1..10000] >> writeChan cvar "done"
 addChanListener cvar l
 liftIO $ forkIO $ loop
 return ()



callCalc l  = do
 cvar <- liftIO newCVar
 let disp x = do when (x `mod` 100 == 0) yield 
                 prnt (show x)
 let loop = mapM disp [1..100000] >> writeCVar cvar "done"
 liftIO $ forkIO $ loop
 addCVarListener cvar l
 return ()
  
\end{code}
