module Graphics.HGL.Draw.Text
(
text
#if !X_DISPLAY_MISSING
, textInfo
#endif
, RGB(RGB)
, setTextColor
, setBkColor
, BkMode(Opaque, Transparent)
, setBkMode
, Alignment
, HAlign(Left', Center, Right')
, VAlign(Top, Baseline, Bottom)
, setTextAlignment
) where
#if !X_DISPLAY_MISSING
import qualified Graphics.X11.Xlib as X
import Graphics.HGL.X11.Types
import Control.Concurrent.MVar (readMVar, takeMVar, putMVar)
#else
import qualified Graphics.Win32 as Win32
import Graphics.HGL.Win32.Types
import Data.Bits
#endif
import Graphics.HGL.Units (Point, Size)
import Graphics.HGL.Draw.Monad (Graphic, Draw)
import Graphics.HGL.Internals.Draw (mkDraw)
import Graphics.HGL.Internals.Types
(RGB(..), BkMode(..), Alignment, HAlign(..), VAlign(..))
text :: Point -> String -> Graphic
#if !X_DISPLAY_MISSING
textInfo :: String -> Draw (Point,Size)
#endif
setTextColor :: RGB -> Draw RGB
setBkColor :: RGB -> Draw RGB
setBkMode :: BkMode -> Draw BkMode
setTextAlignment :: Alignment -> Draw Alignment
#if !X_DISPLAY_MISSING
text p s = mkDraw (\ dc -> do
bs <- readMVar (ref_bits dc)
let
Font f = font bs
(halign, valign) = textAlignment bs
width = X.textWidth f s
ascent = X.ascentFromFontStruct f
descent = X.descentFromFontStruct f
x' = case halign of
Left' -> x
Center -> x width `div` 2
Right' -> x width + 1
y' = case valign of
Top -> y + ascent
Baseline -> y
Bottom -> y descent + 1
draw (bkMode bs) (disp dc) (drawable dc) (textGC dc) x' y' s
)
where
X.Point x y = fromPoint p
draw Transparent = X.drawString
draw Opaque = X.drawImageString
textInfo s = mkDraw $ \ dc -> do
bs <- readMVar (ref_bits dc)
let
Font f = font bs
(halign, valign) = textAlignment bs
width = X.textWidth f s
ascent = X.ascentFromFontStruct f
descent = X.descentFromFontStruct f
x1 = case halign of
Left' -> 0
Center -> width `div` 2
Right' -> width + 1
y1 = case valign of
Top -> ascent
Baseline -> 0
Bottom -> descent + 1
x2 = x1 + width
y2 = y1 + ascent + descent
(x1',x2') = (min x1 x2, max x1 x2)
(y1',y2') = (min y1 y2, max y1 y2)
return (toPoint (X.Point x1 y1), toSize (fromIntegral (x2'x1'), fromIntegral (y2'y1')))
setTextColor x = mkDraw $ \ dc -> do
bs <- takeMVar (ref_bits dc)
putMVar (ref_bits dc) bs{textColor=x}
p <- lookupColor (disp dc) x
X.setForeground (disp dc) (textGC dc) p
return (textColor bs)
setBkColor x = mkDraw $ \ dc -> do
bs <- takeMVar (ref_bits dc)
putMVar (ref_bits dc) bs{bkColor=x}
p <- lookupColor (disp dc) x
X.setBackground (disp dc) (textGC dc) p
return (bkColor bs)
setBkMode x = mkDraw $ \ dc -> do
bs <- takeMVar (ref_bits dc)
putMVar (ref_bits dc) bs{bkMode=x}
return (bkMode bs)
setTextAlignment x = mkDraw $ \ dc -> do
bs <- takeMVar (ref_bits dc)
putMVar (ref_bits dc) bs{textAlignment=x}
return (textAlignment bs)
#else /* X_DISPLAY_MISSING */
type TextAlignment = Win32.TextAlignment
fromAlignment :: Alignment -> TextAlignment
fromAlignment (ha,va) = hAlign ha .|. vAlign va
hAlign :: HAlign -> TextAlignment
hAlign Left' = Win32.tA_LEFT
hAlign Center = Win32.tA_CENTER
hAlign Right' = Win32.tA_RIGHT
vAlign :: VAlign -> TextAlignment
vAlign Top = Win32.tA_TOP
vAlign Baseline = Win32.tA_BASELINE
vAlign Bottom = Win32.tA_BOTTOM
toAlignment :: TextAlignment -> Alignment
toAlignment x = (toHAlign (x .&. hmask), toVAlign (x .&. vmask))
toHAlign x
| x == Win32.tA_LEFT = Left'
| x == Win32.tA_CENTER = Center
| x == Win32.tA_RIGHT = Right'
| otherwise = Center
toVAlign x
| x == Win32.tA_TOP = Top
| x == Win32.tA_BASELINE = Baseline
| x == Win32.tA_BOTTOM = Bottom
| otherwise = Baseline
hmask = Win32.tA_LEFT .|. Win32.tA_CENTER .|. Win32.tA_RIGHT
vmask = Win32.tA_TOP .|. Win32.tA_BASELINE .|. Win32.tA_BOTTOM
fromBkMode :: BkMode -> Win32.BackgroundMode
fromBkMode Opaque = Win32.oPAQUE
fromBkMode Transparent = Win32.tRANSPARENT
toBkMode :: Win32.BackgroundMode -> BkMode
toBkMode x
| x == Win32.oPAQUE = Opaque
| x == Win32.tRANSPARENT = Transparent
text (x,y) s = mkDraw $ \ hdc ->
Win32.textOut hdc (fromDimension x) (fromDimension y) s
setTextColor c = mkDraw (\hdc -> do
c' <- Win32.setTextColor hdc (fromRGB c)
return (toRGB c'))
setBkColor c = mkDraw (\hdc -> do
c' <- Win32.setBkColor hdc (fromRGB c)
return (toRGB c'))
setBkMode m = mkDraw (\hdc -> do
m' <- Win32.setBkMode hdc (fromBkMode m)
return (toBkMode m'))
setTextAlignment new_alignment = mkDraw (\hdc -> do
old <- Win32.setTextAlign hdc (fromAlignment new_alignment)
return (toAlignment old)
)
#endif /* X_DISPLAY_MISSING */