    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.HGL.Utils
    -- Copyright   :  (c) Alastair Reid, 1999-2003
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  libraries@haskell.org
    -- Stability   :  provisional
    -- Portability :  non-portable (requires concurrency)
    --
    -- Utility functions for a simple graphics library.
    --
    -----------------------------------------------------------------------------

    module Graphics.HGL.Utils
            (
    	-- * Windows
    	  openWindow		-- :: Title -> Size -> IO Window
    	, clearWindow		-- :: Window -> IO ()
    	, drawInWindow		-- :: Window -> Graphic -> IO ()
    	, withWindow		-- :: Title -> Size -> (Window -> IO a) -> IO a
    	, withWindow_		-- :: Title -> Size -> (Window -> IO a) -> IO ()
    	, runWindow		-- :: Title -> Size -> (Window -> IO a) -> IO ()
    	, getWindowSize		-- :: Window -> IO Size
    	-- * Specific events
    	-- ** Mouse events
    	, getLBP		-- :: Window -> IO Point
    	, getRBP		-- :: Window -> IO Point
    	, getButton		-- :: Window -> Bool -> Bool -> IO Point
    	-- ** Keyboard events
    	, getKey		-- :: Window -> IO Key
    	, getKeyEx		-- :: Window -> Bool -> IO Key
    	, wGetChar		-- :: Window -> IO Char
    	-- * Graphics
    	-- ** Combining Graphics
    	, emptyGraphic		-- :: Graphic
    	, overGraphic		-- :: Graphic -> Graphic -> Graphic
    	, overGraphics		-- :: [Graphic] -> Graphic
    	-- ** Graphic modifiers
    	, withFont		-- :: Font -> Graphic -> Graphic
    	, withTextColor		-- :: RGB -> Graphic -> Graphic
    	, withTextAlignment	-- :: Alignment -> Graphic -> Graphic
    	, withBkColor		-- :: RGB -> Graphic -> Graphic
    	, withBkMode		-- :: BkMode -> Graphic -> Graphic
    	, withPen		-- :: Pen -> Graphic -> Graphic
    	, withBrush		-- :: Brush -> Graphic -> Graphic
    	, withRGB		-- :: RGB -> Graphic -> Graphic
    	-- * Named colors
    	, Color(..)
    	, colorList		-- :: [(Color, RGB)]
    	, colorTable		-- :: Array Color RGB
    	, withColor		-- :: Color -> Graphic -> Graphic
    	-- * Concurrency
    	, par			-- :: IO a -> IO b -> IO (a, b)
    	, par_			-- :: IO a -> IO b -> IO ()
    	, parMany		-- :: [IO ()] -> IO ()

            ) where

    import Graphics.HGL.Core
    import Control.Concurrent
            ( newEmptyMVar, takeMVar, putMVar
            , forkIO
            )
    import qualified Control.Exception as E
    import Data.Ix(Ix)
    import Data.Array(Array,array,(!))

    ----------------------------------------------------------------
    -- Interface
    ----------------------------------------------------------------

    -- | Create a window with the given title and size.
    openWindow        :: Title -> Size -> IO Window
    -- | Erase all drawing in the window.
    -- (That is, set the 'Graphic' held by the window to 'emptyGraphic'.)
    clearWindow       :: Window -> IO ()
    -- | Draw the given graphic on the window, on top of anything that is
    -- already there.
    -- (That is, combine the given 'Graphic' and the one held by the window
    -- using 'overGraphic', store the result in the window, and display it.)
    drawInWindow      :: Window -> Graphic -> IO ()
    -- | Run an action inside a new window, ensuring that the window is destroyed
    -- on exit.
    withWindow        :: Title -> Size -> (Window -> IO a) -> IO a
    -- | A variant of 'withWindow' that ignores the result of the action.
    withWindow_       :: Title -> Size -> (Window -> IO a) -> IO ()
    -- | A combination of 'runGraphics' and 'withWindow_'.
    runWindow         :: Title -> Size -> (Window -> IO a) -> IO ()

    -- | The current size of the window.
    getWindowSize     :: Window -> IO Size
    -- | Wait for a press of the left mouse button,
    -- and return the position of the mouse cursor.
    getLBP            :: Window -> IO Point
    -- | Wait for a press of the right mouse button,
    -- and return the position of the mouse cursor.
    getRBP            :: Window -> IO Point
    -- | Wait for a mouse button to be pressed or released,
    -- and return the position of the mouse cursor.
    getButton         :: Window
                      -> Bool	-- ^ if 'True', wait for the left button
                      -> Bool	-- ^ if 'True', wait for a press;
    				-- otherwise wait for a release.
                      -> IO Point
    -- | Wait until a key is pressed and released.
    getKey            :: Window -> IO Key
    -- | Wait until a key is pressed (if the second argument is 'True')
    -- or released (otherwise).
    getKeyEx          :: Window -> Bool -> IO Key
    -- | Wait for a translated character (from a key press).
    -- Use in preference to 'getKey' if the aim is to read text.
    wGetChar          :: Window -> IO Char

    -- | An empty drawing.
    emptyGraphic      :: Graphic
    -- | A composite drawing made by overlaying the first argument on the second.
    overGraphic       :: Graphic -> Graphic -> Graphic
    -- | Overlay a list of drawings.
    overGraphics      :: [Graphic] -> Graphic

    -- | Set the default font for a drawing.
    withFont          :: Font      -> Graphic -> Graphic
    -- | Set the default color for drawing text.
    withTextColor     :: RGB       -> Graphic -> Graphic
    -- | Set the default alignment of text in a drawing.
    withTextAlignment :: Alignment -> Graphic -> Graphic
    -- | Set the default background color for drawing text with background
    -- mode 'Opaque'.  The background color is ignored when the mode is
    -- 'Transparent'.
    withBkColor       :: RGB       -> Graphic -> Graphic
    -- | Set the default background mode for drawing text.
    withBkMode        :: BkMode    -> Graphic -> Graphic
    -- | Set the default pen for drawing lines.
    withPen           :: Pen       -> Graphic -> Graphic
    -- | Set the default brush for filling shapes.
    withBrush         :: Brush     -> Graphic -> Graphic
    -- | A convenience function that sets the brush,
    -- pen and text colors to the same value.
    withRGB           :: RGB       -> Graphic -> Graphic

    -- | Named colors.
    data Color
      = Black
      | Blue
      | Green
      | Cyan
      | Red
      | Magenta
      | Yellow
      | White
     deriving (Eq, Ord, Bounded, Enum, Ix, Show, Read)

    -- | A mapping of 'Color' names to 'RGB' triples.
    colorList  :: [(Color, RGB)]
    -- | A mapping of 'Color' names to 'RGB' triples.
    colorTable :: Array Color RGB
    -- | Set the default drawing color for a 'Graphic'.
    withColor  :: Color -> Graphic -> Graphic

    -- | Run two 'IO' actions in parallel and terminate when both actions terminate.
    par               :: IO a -> IO b -> IO (a,b)
    -- | Run two 'IO' actions in parallel and terminate when both actions terminate,
    -- discarding the results of the actions.
    par_              :: IO a -> IO b -> IO ()
    -- | Run several 'IO' actions in parallel and terminate when all actions
    -- terminate, discarding the results of the actions.
    parMany           :: [IO ()] -> IO ()

    ----------------------------------------------------------------
    -- Implementation
    ----------------------------------------------------------------

    -- Window operations

    openWindow name size = openWindowEx name Nothing size Unbuffered Nothing

    clearWindow w = setGraphic w emptyGraphic

    getWindowSize w = do
            (pt,sz) <- getWindowRect w
            return sz

    drawInWindow w p = do
            modGraphic w (p `overGraphic`)
            directDraw w p

    withWindow name size = E.bracket (openWindow name size) closeWindow
    withWindow_ name size f = withWindow name size f >> return ()
    runWindow name size f = runGraphics (withWindow_ name size f)

    -- Event operations

    -- wait for left/right mouse button up (SOE p148)
    getLBP w = getButton w True  True
    getRBP w = getButton w False True

    -- Wait for a key to go down then a (possibly different) key to go up
    getKey w = do { getKeyEx w True; getKeyEx w False }

    -- wait for key to go down/up
    getKeyEx w down = loop
     where
      loop = do
            e <- getWindowEvent w
            case e of
              Key { keysym = k, isDown = isDown }
                |  isDown == down
                -> return k
              _ -> loop

    getButton w left down = loop
     where
      loop = do
            e <- getWindowEvent w
            case e of
              Button {pt=pt,isLeft=isLeft,isDown=isDown}
                | isLeft == left && isDown == down
                -> return pt
              _ -> loop

    wGetChar w = loop
     where
      loop = do
            e <- getWindowEvent w
            case e of
              Char {char = c} -> return c
              _               -> loop

    -- Graphic

    --elsewhere: type Graphic = Draw ()
    emptyGraphic        = return ()
    g1 `overGraphic` g2 = g2 >> g1
    overGraphics        = foldr overGraphic emptyGraphic

    -- Graphic modifiers

    withFont          x = bracket_ (selectFont       x) selectFont
    withTextAlignment x = bracket_ (setTextAlignment x) setTextAlignment
    withTextColor     x = bracket_ (setTextColor     x) setTextColor
    withBkColor       x = bracket_ (setBkColor       x) setBkColor
    withBkMode        x = bracket_ (setBkMode        x) setBkMode
    withPen           x = bracket_ (selectPen        x) selectPen
    withBrush         x = bracket_ (selectBrush      x) selectBrush

    withRGB c p =
      mkBrush c       $ \ brush ->
      withBrush brush $
      mkPen Solid 2 c $ \ pen ->
      withPen pen     $
      withTextColor c $
      p

    colorList =
      [ (Black   , RGB   0   0   0)
      , (Blue    , RGB   0   0 255)
      , (Green   , RGB   0 255   0)
      , (Cyan    , RGB   0 255 255)
      , (Red     , RGB 255   0   0)
      , (Magenta , RGB 255   0 255)
      , (Yellow  , RGB 255 255   0)
      , (White   , RGB 255 255 255)
      ]

    colorTable = array (minBound, maxBound) colorList

    withColor c g = withRGB (colorTable ! c) g

    -- Concurrency primitives

    par m1 m2 = do
      v1 <- newEmptyMVar
      v2 <- newEmptyMVar
      forkIO (m1 >>= putMVar v1)
      forkIO (m2 >>= putMVar v2)
      a <- takeMVar v1
      b <- takeMVar v2
      return (a,b)

    par_ m1 m2 = do
      v1 <- newEmptyMVar
      v2 <- newEmptyMVar
      forkIO (m1 >> putMVar v1 ())
      forkIO (m2 >> putMVar v2 ())
      takeMVar v1
      takeMVar v2
      return ()

    parMany ms = foldr par_ (return ()) ms

    ----------------------------------------------------------------
    -- End
    ----------------------------------------------------------------