null-canvas-0.2.4: Graphics/Blank/Context.hs

module Graphics.Blank.Context where

import Control.Concurrent
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Char

import Graphics.Blank.Events

-- | 'Context' is our abstact handle into a specific 2d-context inside a browser.
data Context = Context
        { theSize     :: (Float,Float)
        , theDraw     :: MVar String
        , eventHandle :: MVar (Map EventName EventQueue)
        , sessionNo   :: Int
        }

-- | 'events' gets the raw event queue for a specific event type.
events :: Context -> EventName -> IO EventQueue
events cxt@(Context _ _ callbacks num) a = do
        db <- takeMVar callbacks
        case Map.lookup a db of
          Just var -> do
            putMVar callbacks db
            return var
          Nothing -> do
            var <- newEventQueue
            putMVar callbacks $ Map.insert a var db
            sendToCanvas cxt (("register('" ++ map toLower (show a) ++ "'," ++ show num ++ ");") ++)
            return var

-- | internal command to send a message to the canvas.
sendToCanvas :: Context -> ShowS -> IO ()
sendToCanvas (Context _ var _ num) cmds = putMVar var $ "if (session == " ++ show num ++ "){var c = getContext();" ++ cmds "}"