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 Region:
20sig
21    type HDC and HBRUSH and HRGN and HPEN
22    type POINT = { x: int, y: int }
23    type RECT = { top: int, left: int, bottom: int, right: int }
24
25    type RegionOperation
26    val RGN_AND : RegionOperation
27    val RGN_COPY : RegionOperation
28    val RGN_DIFF : RegionOperation
29    val RGN_ERROR : RegionOperation
30    val RGN_OR : RegionOperation
31    val RGN_XOR : RegionOperation
32
33    type ResultRegion
34    val COMPLEXREGION : ResultRegion
35    val NULLREGION : ResultRegion
36    val ERROR : ResultRegion
37    val SIMPLEREGION : ResultRegion
38
39    type PolyFillMode
40    val ALTERNATE : PolyFillMode
41    val WINDING : PolyFillMode
42
43    val CombineRgn : HRGN * HRGN * HRGN * RegionOperation -> ResultRegion
44    val CreateEllipticRgn : RECT -> HRGN
45    val CreatePolygonRgn : POINT list * PolyFillMode -> HRGN
46    val CreateRectRgn : RECT -> HRGN
47    val CreateRoundRectRgn : RECT * int * int -> HRGN
48    val EqualRgn : HRGN * HRGN -> bool
49    val FillRgn : HDC * HRGN * HBRUSH -> unit
50    val FrameRgn : HDC * HRGN * HBRUSH * int * int -> unit
51    val GetPolyFillMode : HDC -> PolyFillMode
52    val GetRgnBox : HRGN -> RECT
53    val InvertRgn : HDC * HRGN -> unit
54    val OffsetRgn : HRGN * int * int -> ResultRegion
55    val PaintRgn : HDC * HRGN -> unit
56    val PtInRegion : HRGN * int * int -> bool
57    val RectInRegion : HRGN * RECT -> bool
58    val SetPolyFillMode : HDC * PolyFillMode -> PolyFillMode
59    val SetRectRgn : HRGN * RECT -> unit
60
61  end =
62struct
63    local
64        open Foreign Base
65    in
66        type HRGN = Base.HRGN and HBRUSH = Base.HBRUSH and HDC = Base.HDC
67        and HPEN = HPEN and RECT = RECT and POINT = POINT
68
69        open GdiBase
70
71        local
72            datatype PolyFillMode =
73            W of int
74        in
75            type PolyFillMode = PolyFillMode
76            val POLYFILLMODE = absConversion {abs = W, rep = fn W n => n} cInt
77        
78            val ALTERNATE                                    = W (1)
79            val WINDING                                      = W (2)
80        end
81
82        val CombineRgn                 = winCall4(gdi "CombineRgn") (cHRGN,cHRGN,cHRGN,REGIONOPERATION) RESULTREGION 
83        val EqualRgn                   = winCall2(gdi "EqualRgn") (cHRGN,cHRGN) cBool
84        val FillRgn                    = winCall3(gdi "FillRgn") (cHDC,cHRGN,cHBRUSH) (successState "FillRgn")
85        val FrameRgn                   = winCall5(gdi "FrameRgn") (cHDC,cHRGN,cHBRUSH,cInt,cInt) (successState "FrameRgn")
86        val GetPolyFillMode            = winCall1(gdi "GetPolyFillMode") (cHDC) POLYFILLMODE
87        val InvertRgn                  = winCall2(gdi "InvertRgn") (cHDC,cHRGN) (successState "InvertRgn")
88        val OffsetRgn                  = winCall3(gdi "OffsetRgn") (cHRGN,cInt,cInt) RESULTREGION
89        val PaintRgn                   = winCall2(gdi "PaintRgn") (cHDC,cHRGN) (successState "PaintRgn")
90        val PtInRegion                 = winCall3(gdi "PtInRegion") (cHRGN,cInt,cInt) cBool
91        val RectInRegion               = winCall2(gdi "RectInRegion") (cHRGN,cRect) cBool
92        val SetPolyFillMode            = winCall2(gdi "SetPolyFillMode") (cHDC,POLYFILLMODE) POLYFILLMODE
93
94        local
95            val getRgnBox = winCall2(gdi "GetRgnBox") (cHRGN, cStar cRect) cInt
96            val zeroRect = {top=0, bottom=0, left=0, right=0}
97        in
98            fun GetRgnBox hr =
99            let val v = ref zeroRect in checkResult(getRgnBox(hr, v) <> 0); !v end
100        end
101
102        local
103            val setRectRgn = winCall5 (gdi "SetRectRgn") (cHRGN,cInt,cInt,cInt,cInt)  (successState "SetRectRgn")
104        in
105            fun SetRectRgn (h, { left, top, right, bottom }) = setRectRgn(h,left,top,right,bottom)
106        end
107        
108        local
109            val createEllipticRgn = winCall4 (gdi "CreateEllipticRgn") (cInt,cInt,cInt,cInt) cHRGN
110        in
111            fun CreateEllipticRgn {left,top,right,bottom} = createEllipticRgn(left,top,right,bottom)
112        end
113        
114        local
115            val createRectRgn = winCall4 (gdi "CreateRectRgn") (cInt,cInt,cInt,cInt) cHRGN
116        in
117            fun CreateRectRgn {left,top,right,bottom} = createRectRgn(left,top,right,bottom)
118        end
119        
120        local
121            val createRoundRectRgn = winCall6 (gdi "CreateRoundRectRgn") (cInt,cInt,cInt,cInt,cInt,cInt) cHRGN
122        in
123            fun CreateRoundRectRgn({left,top,right,bottom},w,h) =
124                createRoundRectRgn(left,top,right,bottom,w,h)
125        end
126
127        local
128            val createPolygonRgn = winCall3 (gdi "CreatePolygonRgn") (cPointer,cInt,POLYFILLMODE) cHRGN
129            val ptList = list2Vector cPoint
130        in
131            fun CreatePolygonRgn (pts: POINT list, fmode) = 
132            let
133                val (ptarr, count) = ptList pts
134            in
135                (createPolygonRgn(ptarr,count,fmode) handle ex => (Memory.free ptarr; raise ex))
136                    before Memory.free ptarr
137            end
138        end
139    
140(*      fun ExtCreateRegion (x,rects,rectmain) =                        
141        let val {r11,r12,r21,r22,tx,ty} = breakXForm x   
142            val xform = make_struct
143                          [ (Cfloat,toCfloat r11),
144                            (Cfloat,toCfloat r12),
145                            (Cfloat,toCfloat r21),
146                            (Cfloat,toCfloat r22),
147                            (Cfloat,toCfloat tx),
148                            (Cfloat,toCfloat ty) ]
149        
150            val count = List.length rects
151        
152            val rectarr = alloc count (Cstruct [Clong,Clong,Clong,Clong])
153        
154            fun pl2a v n [] = () 
155            |   pl2a v n ({left,top,right,bottom} :: rest) = 
156            let val item = make_struct [(Clong,toClong left),
157                                        (Clong,toClong top),
158                                        (Clong,toClong right),
159                                        (Clong,toClong bottom)] 
160            in
161              ( assign (Cstruct [Clong,Clong,Clong,Clong]) 
162                       (offset n (Cstruct [Clong,Clong,Clong,Clong]) v) item ;
163                pl2a v (n+1) rest ) 
164            end
165        
166            val u = pl2a rectarr 0 rects
167            val {left,top,right,bottom} = rectmain 
168        
169            val rgndata = make_struct
170                            [ (Clong,toClong 32),
171                              (Clong,toClong 1),
172                              (Clong,toClong count),
173                              (Clong,toClong 0  ),
174                              (Clong,toClong left),
175                              (Clong,toClong top),
176                              (Clong,toClong right),
177                              (Clong,toClong bottom),
178                              (Cvoid,rectarr) ]
179        
180            val struct_size = 64 + 16 * count
181        in
182          winCall3 (gdi "ExtCreateRegion")
183                 (POINTER,INT,POINTER) (cHRGN)
184                 (address xform,struct_size,address rgndata)
185        end
186*)      
187(*      fun GetRegionData h =
188        let
189          val bufsize = winCall3 (gdi "GetRegionData")
190                            (cHRGN,LONG,POINTER) (LONG)
191                            (h,0,toCint 0)
192        
193          val rgndata = alloc 1 (Cstruct [Clong,Clong,Clong,Clong,
194                                          Clong,Clong,Clong,Clong,Cvoid])
195        
196          val res =  winCall3 (gdi "GetRegionData")
197                            (cHRGN,LONG,POINTER) (LONG)
198                            (h,bufsize,address rgndata)
199        in
200          "not implemented"
201        end 
202*)
203        (*
204        Other Region Functions
205        CreateEllipticRgnIndirect  
206        CreatePolyPolygonRgn  
207        CreateRectRgnIndirect  
208        ExtCreateRegion  
209        GetRegionData  
210        *)
211
212    end
213end;
214