module Graphics.HGL.Draw.Pen
( Pen
, Style(Solid, Dash, Dot, DashDot, DashDotDot, Null, InsideFrame)
, createPen
, deletePen
, selectPen
, mkPen
) where
import Graphics.HGL.Draw.Text (RGB)
import Graphics.HGL.Draw.Monad (Draw, ioToDraw)
import Graphics.HGL.Internals.Types (Style(..))
import Graphics.HGL.Internals.Draw (mkDraw)
#if !X_DISPLAY_MISSING
import Graphics.HGL.X11.Types
import Graphics.HGL.X11.Display
import qualified Graphics.X11.Xlib as X
import Control.Concurrent (takeMVar, putMVar)
#else
import Graphics.HGL.Win32.Types
import qualified Graphics.Win32 as Win32
import Graphics.HGL.Draw.Monad (bracket)
#endif
#if X_DISPLAY_MISSING
newtype Pen = Pen Win32.HPEN
#endif
createPen :: Style -> Int -> RGB -> IO Pen
deletePen :: Pen -> IO ()
selectPen :: Pen -> Draw Pen
mkPen :: Style -> Int -> RGB -> (Pen -> Draw a) -> Draw a
#if !X_DISPLAY_MISSING
createPen style width col = do
display <- getDisplay
pixel <- lookupColor display col
return (Pen style width pixel)
deletePen _ = return ()
selectPen p@(Pen _ lwidth c) = mkDraw $ \ dc -> do
bs <- takeMVar (ref_bits dc)
putMVar (ref_bits dc) bs{pen=p}
X.setForeground (disp dc) (paintGC dc) c
X.setLineAttributes (disp dc) (paintGC dc) (fromIntegral lwidth) X.lineSolid X.capButt X.joinMiter
return (pen bs)
mkPen style width color g = do
p <- ioToDraw $ createPen style width color
g p
#else /* X_DISPLAY_MISSING */
style :: Style -> Win32.PenStyle
style Solid = Win32.pS_SOLID
style Dash = Win32.pS_DASH
style Dot = Win32.pS_DOT
style DashDot = Win32.pS_DASHDOT
style DashDotDot = Win32.pS_DASHDOTDOT
style Null = Win32.pS_NULL
style InsideFrame = Win32.pS_INSIDEFRAME
createPen sty width c =
Win32.createPen (style sty) (fromIntegral width) (fromRGB c) >>= return . Pen
deletePen (Pen pen) =
Win32.deletePen pen
selectPen (Pen p) = mkDraw (\hdc -> do
p' <- Win32.selectPen hdc p
return (Pen p'))
mkPen sty width c =
bracket (ioToDraw $ createPen sty width c)
(ioToDraw . deletePen)
#endif /* X_DISPLAY_MISSING */