module Graphics.HGL.Draw.Region
( Region
#if !X_DISPLAY_MISSING
, emptyRegion
#endif
, rectangleRegion
, ellipseRegion
, polygonRegion
, intersectRegion
, unionRegion
, subtractRegion
, xorRegion
, regionToGraphic
) where
import Foreign.C.Types
import Graphics.HGL.Units (Point, Angle)
import Graphics.HGL.Draw.Monad (Graphic)
import Graphics.HGL.Internals.Draw (mkDraw)
#if !X_DISPLAY_MISSING
import Graphics.HGL.X11.Types (DC(..), fromPoint)
import qualified Graphics.X11.Xlib as X
#else
import Graphics.HGL.Win32.Types
import qualified Graphics.Win32 as Win32
#endif
import System.IO.Unsafe( unsafePerformIO )
#if !X_DISPLAY_MISSING
newtype Region = MkRegion X.Region
#else
newtype Region = MkRegion Win32.HRGN
#endif
#if !X_DISPLAY_MISSING
emptyRegion :: Region
#endif
rectangleRegion :: Point -> Point -> Region
ellipseRegion :: Point -> Point -> Region
polygonRegion :: [Point] -> Region
intersectRegion :: Region -> Region -> Region
unionRegion :: Region -> Region -> Region
subtractRegion :: Region -> Region -> Region
xorRegion :: Region -> Region -> Region
regionToGraphic :: Region -> Graphic
#if !X_DISPLAY_MISSING
emptyXRegion = unsafePerformIO X.createRegion
emptyRegion = MkRegion emptyXRegion
rectangleRegion (x0,y0) (x1,y1) =
polygonRegion [(x0,y0),(x0,y1),(x1,y1),(x1,y0)]
ellipseRegion p0 p1 = MkRegion $ unsafePerformIO $ do
X.polygonRegion pts X.evenOddRule
where
X.Point x0 y0 = fromPoint p0
X.Point x1 y1 = fromPoint p1
rx = (x1 x0) `div` 2
ry = (y1 y0) `div` 2
cx = x0 + rx
cy = y0 + ry
rx' = fromIntegral rx
ry' = fromIntegral ry
pts = [ X.Point (cx + round (rx' * c)) (cy + round (ry' * s))
| (c,s) <- cos'n'sins
]
cos'n'sins :: [(Double,Double)]
cos'n'sins = [ (cos a, sin a) | a <- angles ]
angles :: [Angle]
angles = take 40 [0, pi/20 .. ]
polygonRegion pts = MkRegion $ unsafePerformIO $ do
X.polygonRegion (map fromPoint pts) X.evenOddRule
intersectRegion = combine X.intersectRegion
unionRegion = combine X.unionRegion
subtractRegion = combine X.subtractRegion
xorRegion = combine X.xorRegion
type XRegionOp = X.Region -> X.Region -> X.Region -> IO CInt
combine :: XRegionOp -> Region -> Region -> Region
combine op (MkRegion r1) (MkRegion r2) = unsafePerformIO $ do
r <- X.createRegion
op r1 r2 r
return (MkRegion r)
regionToGraphic (MkRegion r) = mkDraw $ \ dc -> do
X.setRegion (disp dc) (brushGC dc) r
X.fillRectangle (disp dc) (drawable dc) (brushGC dc) 0 0 (1) (1)
X.setRegion (disp dc) (brushGC dc) emptyXRegion
return ()
#else /* X_DISPLAY_MISSING */
rectangleRegion pt0 pt1 = unsafePerformIO $ do
r <- Win32.createRectRgn x0 y0 x1 y1
return (MkRegion r)
where
(x0,y0) = fromPoint pt0
(x1,y1) = fromPoint pt1
ellipseRegion pt0 pt1
| x0 /= x1 && y0 /= y1
= unsafePerformIO $ do
r <- Win32.createEllipticRgn x0 y0 x1 y1
return (MkRegion r)
| otherwise
= rectangleRegion pt0 pt1
where
(x0,y0) = fromPoint pt0
(x1,y1) = fromPoint pt1
polygonRegion pts = unsafePerformIO $ do
r <- Win32.createPolygonRgn (map fromPoint pts) Win32.wINDING
return (MkRegion r)
combine :: Win32.ClippingMode -> Region -> Region -> Region
combine mode (MkRegion r1) (MkRegion r2) = unsafePerformIO $ do
r <- Win32.createRectRgn 0 0 0 0
Win32.combineRgn r r1 r2 mode
return (MkRegion r)
regionToGraphic (MkRegion r) = mkDraw (\hdc -> Win32.paintRgn hdc r)
intersectRegion = combine Win32.rGN_AND
unionRegion = combine Win32.rGN_OR
xorRegion = combine Win32.rGN_XOR
subtractRegion = combine Win32.rGN_DIFF
#endif /* X_DISPLAY_MISSING */