module Graphics.Blank.GHCi (splatCanvas) where
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Graphics.Blank (Options(..),port,send, Canvas, blankCanvas)
import System.IO.Unsafe (unsafePerformIO)
splatCanvas :: Options -> Canvas () -> IO ()
splatCanvas :: Options -> Canvas () -> IO ()
splatCanvas Options
opts Canvas ()
cmds = do
Maybe (TMVar (Canvas ()))
optCh <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
[(Int, TMVar (Canvas ()))]
ports <- forall a. TVar a -> STM a
readTVar TVar [(Int, TMVar (Canvas ()))]
usedPorts
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Options -> Int
port Options
opts) [(Int, TMVar (Canvas ()))]
ports of
Just TMVar (Canvas ())
ch -> do forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Canvas ())
ch Canvas ()
cmds
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe (TMVar (Canvas ()))
Nothing -> do TMVar (Canvas ())
ch <- forall a. a -> STM (TMVar a)
newTMVar Canvas ()
cmds
forall a. TVar a -> a -> STM ()
writeTVar TVar [(Int, TMVar (Canvas ()))]
usedPorts ((Options -> Int
port Options
opts,TMVar (Canvas ())
ch)forall a. a -> [a] -> [a]
:[(Int, TMVar (Canvas ()))]
ports)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just TMVar (Canvas ())
ch)
case Maybe (TMVar (Canvas ()))
optCh of
Maybe (TMVar (Canvas ()))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just TMVar (Canvas ())
ch -> do ThreadId
_ <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ Options -> (DeviceContext -> IO ()) -> IO ()
blankCanvas Options
opts forall a b. (a -> b) -> a -> b
$ \ DeviceContext
cxt -> forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
Canvas ()
cmd <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
takeTMVar TMVar (Canvas ())
ch
forall a. DeviceContext -> Canvas a -> IO a
send DeviceContext
cxt Canvas ()
cmd
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# NOINLINE usedPorts #-}
usedPorts :: TVar [(Int, TMVar (Canvas ()))]
usedPorts :: TVar [(Int, TMVar (Canvas ()))]
usedPorts = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (TVar a)
newTVarIO []