1(*
2    Copyright (c) 2001, 2015
3        David C.J. Matthews
4
5    This library is free software; you can redistribute it and/or
6    modify it under the terms of the GNU Lesser General Public
7    License version 2.1 as published by the Free Software Foundation.
8    
9    This library is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12    Lesser General Public License for more details.
13    
14    You should have received a copy of the GNU Lesser General Public
15    License along with this library; if not, write to the Free Software
16    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
17*)
18
19structure Clipping :
20  sig
21    type HDC and HRGN
22    type RECT = { top: int, left: int, bottom: int, right: int }
23    type POINT = { x: int, y: int }
24    type RegionOperation = Region.RegionOperation
25    type ResultRegion = Region.ResultRegion
26
27    val ExcludeClipRect : HDC * RECT -> ResultRegion
28    val ExtSelectClipRgn : HDC * HRGN * RegionOperation -> ResultRegion
29    val GetClipBox : HDC -> ResultRegion * RECT
30    val GetClipRgn : HDC * HRGN -> unit
31    val GetMetaRgn : HDC * HRGN -> unit
32    val IntersectClipRect : HDC * RECT -> ResultRegion
33    val OffsetClipRgn : HDC * int * int -> ResultRegion
34    val PtVisible : HDC * POINT -> bool
35    val RectVisible : HDC * RECT -> bool
36    val SelectClipPath : HDC * RegionOperation -> unit
37    val SelectClipRgn : HDC * HRGN -> unit
38    val SetMetaRgn : HDC -> unit
39  end =
40struct
41    local
42        open Foreign Base GdiBase
43    in
44        type RegionOperation = RegionOperation and ResultRegion = ResultRegion
45        type RECT = RECT and HDC = HDC and HRGN = HRGN and POINT = POINT
46        
47        val ExtSelectClipRgn           = winCall3(gdi "ExtSelectClipRgn") (cHDC,cHRGN,REGIONOPERATION) RESULTREGION
48        val GetClipRgn                 = winCall2(gdi "GetClipRgn") (cHDC,cHRGN) (successState "GetClipRgn")
49        val GetMetaRgn                 = winCall2(gdi "GetMetaRgn") (cHDC,cHRGN) (successState "GetMetaRgn")
50        val OffsetClipRgn              = winCall3(gdi "OffsetClipRgn") (cHDC,cInt,cInt) RESULTREGION
51        val RectVisible                = winCall2(gdi "RectVisible") (cHDC,cConstStar cRect) cBool
52        val SelectClipPath             = winCall2(gdi "SelectClipPath") (cHDC,REGIONOPERATION) (successState "SelectClipPath")
53        val SelectClipRgn              = winCall2(gdi "SelectClipRgn") (cHDC,cHRGN) (successState "SelectClipRgn")
54        val SetMetaRgn                 = winCall1(gdi "SetMetaRgn") (cHDC) (successState "SetMetaRgn")
55        
56        local
57            val ptVisible = winCall3(gdi "PtVisible") (cHDC,cInt,cInt) cBool
58        in
59            fun PtVisible(hd, {x, y}) = ptVisible(hd, x, y)
60        end
61
62        local
63            val excludeClipRect = winCall5 (gdi "ExcludeClipRect") (cHDC,cInt,cInt,cInt,cInt) RESULTREGION
64        in
65            fun ExcludeClipRect (h,{left,top,right,bottom}) = excludeClipRect(h,left,top,right,bottom)
66        end
67
68        local
69            val intersectClipRect =
70                winCall5 (gdi "IntersectClipRect") (cHDC,cInt,cInt,cInt,cInt) RESULTREGION
71        in
72            fun IntersectClipRect (h,{left,top,right,bottom}: RECT) =
73               intersectClipRect(h,left,top,right,bottom)
74        end
75
76        local
77            val getClipBox = winCall2 (gdi "GetClipBox") (cHDC, cStar cRect) RESULTREGION
78            val zeroRect = { top=0, bottom=0, left=0, right=0}
79        in
80            fun GetClipBox hdc =
81                let val v = ref zeroRect val res = getClipBox(hdc, v) in (res, !v) end
82        end
83
84    end
85end;
86