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