1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
module GraphicsRegion
( Region
, mkEmpty, mkRectangle, mkEllipse, mkPolygon
, andRegion, orRegion, xorRegion, diffRegion
, region
) where
import qualified Win32
import GraphicsTypes
import GraphicsUtilities( bracket )
----------------------------------------------------------------
-- The Interface
----------------------------------------------------------------
newtype Region = MkRegion Win32.HRGN
mkEmpty :: (Region -> Picture) -> Picture
mkRectangle :: Point -> Point -> (Region -> Picture) -> Picture
mkEllipse :: Point -> Point -> (Region -> Picture) -> Picture
mkPolygon :: [Point] -> (Region -> Picture) -> Picture
andRegion :: Region -> Region -> (Region -> Picture) -> Picture
orRegion :: Region -> Region -> (Region -> Picture) -> Picture
xorRegion :: Region -> Region -> (Region -> Picture) -> Picture
diffRegion :: Region -> Region -> (Region -> Picture) -> Picture
region :: Region -> Picture
----------------------------------------------------------------
-- The Implementation
----------------------------------------------------------------
mkEmpty p = \ hdc ->
bracket (Win32.createRectRgn 0 0 0 0)
Win32.deleteRegion $ \ r -> p (MkRegion r) hdc
mkRectangle pt0 pt1 p = \ hdc ->
bracket (Win32.createRectRgn x0 y0 x1 y1)
Win32.deleteRegion $ \ r -> p (MkRegion r) hdc
where
(x0,y0) = fromPoint pt0
(x1,y1) = fromPoint pt1
mkEllipse pt0 pt1 p = \ hdc ->
bracket (Win32.createEllipticRgn x0 y0 x1 y1)
Win32.deleteRegion $ \ r -> p (MkRegion r) hdc
where
(x0,y0) = fromPoint pt0
(x1,y1) = fromPoint pt1
mkPolygon pts p = \ hdc ->
bracket (Win32.createPolygonRgn pts' Win32.wINDING)
Win32.deleteRegion $ \ r -> p (MkRegion r) hdc
where
pts' = map fromPoint pts
andRegion = combine Win32.rGN_AND
orRegion = combine Win32.rGN_OR
xorRegion = combine Win32.rGN_XOR
diffRegion = combine Win32.rGN_DIFF
combine :: Win32.ClippingMode -> Region -> Region -> (Region -> Picture) -> Picture
combine mode (MkRegion r1) (MkRegion r2) p = \ hdc -> do
result <- Win32.createRectRgn 0 0 0 0 -- do I really have to do this?
Win32.combineRgn result r1 r2 mode
p (MkRegion result) hdc
region (MkRegion r) hdc = Win32.paintRgn hdc r
----------------------------------------------------------------
-- End
----------------------------------------------------------------
|
