module ConcTcl where
import TclPrimImpl
import Concurrent
import IOExts
import IO
import TclCompatibility
import CVar

-- Some functions used by FranTk to support worker threads.

-- Add a tcl callback that will run the given IO action when called
-- It can be fired by running the IO action returned
primCallback :: IO () -> GUIInfo -> IO (IO (),Remover)
primCallback io g = do
 (s,rm) <- tcl_callback g "." (const $ io)
 return (tcl_ g [tail $ init $ s],rm) 

-- Add an IO action that listens to a CVar and is fired on the Tcl/Tk
-- event loop when a value appears on the CVar
addCVarListener :: CVar a -> (a -> IO ()) -> GUIInfo -> IO (IO ())
addCVarListener cvar act g = do
 ch <- newIORef (error "internal error in addCVarListener")
 (call,rm) <- primCallback (readIORef ch >>= act) g
 t <- forkIO $ do v <- readCVar cvar
	          writeIORef ch v
                  call 
 return $ rm >> killThread t

-- Add an IO action that listens to a Channel and is fired on the Tcl/Tk
-- event loop when a value appears on the Channel
addChanListener :: Chan a -> (a -> IO ()) -> GUIInfo -> IO (IO ())
addChanListener chan act g = do
 chn <- newChan
 (call,rm) <- primCallback (readChan chn >>= act) g
 let loop = do v <- readChan chan
	       writeChan chn v
               call
               loop 
 t <- forkIO loop
 return $ rm >> killThread t