module Graphics.HGL.X11.Display
( getDisplayName
, openDisplay
, closeDisplay
, getDisplay
) where
import Graphics.HGL.Internals.Utilities (modMVar)
import qualified Graphics.X11.Xlib as X
import Control.Concurrent.MVar (MVar, newMVar, readMVar, takeMVar, putMVar)
import Control.Monad (when)
import Data.Maybe (isJust)
import System.Environment (getEnv)
import System.IO.Unsafe (unsafePerformIO)
import qualified Control.Exception as CE
getDisplayName :: IO String
getDisplayName = do
disp <- CE.try (getEnv "DISPLAY") :: IO (Either CE.IOException String)
return (either (const ":0.0") id disp)
displayRef :: MVar (Maybe X.Display)
displayRef = unsafePerformIO (newMVar Nothing)
openDisplay :: String -> IO () -> IO X.Display
openDisplay host cleanup = do
mb_display <- readMVar displayRef
when (isJust mb_display) cleanup
openDisplay'
where
openDisplay' = do
display <- X.openDisplay host
`CE.catch`
(\(e :: CE.SomeException) -> ioError $ userError $ "Unable to open X display " ++ host)
modMVar displayRef (const $ Just display)
return display
closeDisplay :: IO ()
closeDisplay = do
mb_display <- takeMVar displayRef
case mb_display of
Nothing -> do
putMVar displayRef Nothing
Just display -> do
X.closeDisplay display
putMVar displayRef Nothing
getDisplay :: IO X.Display
getDisplay = do
mb_display <- readMVar displayRef
case mb_display of
Nothing -> ioError $ userError "Display not opened yet"
Just display -> return display