{-|
Module:      Graphics.Blank.GHCi
Copyright:   (C) 2014-2015, The University of Kansas
License:     BSD-style (see the file LICENSE)
Maintainer:  Andy Gill
Stability:   Beta
Portability: GHC

The GHCi entry point for @blank-canvas@. Useful for sending multiple
commands to the same port.
-}
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)

-- | splitCanvas is the GHCi entry point into @blank-canvas@.
-- A typical invocation would be
-- 
-- >GHCi> import Graphics.Blank
-- >GHCi> import Graphics.Blank.GHCi
-- >
-- >-- Adding commands to the canvas buffer
-- >GHCi> splatCanvas 3000 $ ( .. canvas commands .. )
-- 
-- The system remembers if it has been called on a specific port before,
-- and if so, uses the previous session.

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    -- run the command
                    forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- common TVar for all ports in use.
{-# 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 []