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 Metafile : 20 sig 21 type HENHMETAFILE 22 type HMETAFILE 23 type HDC (*= Base.HDC*) 24 type RECT = { top: int, left: int, bottom: int, right: int } 25 type SIZE = { cx: int, cy: int } 26 datatype MapMode = datatype Transform.MapMode 27 type METAFILEPICT = {mm: MapMode, size: SIZE, hMF: HMETAFILE} 28 29 type ENHMETAHEADER = 30 { 31 bounds: RECT, frame: RECT, fileSize: int, records: int, 32 handles: int, palEntries: int, resolutionPixels: SIZE, 33 resolutionMM: SIZE, openGL: bool 34 } 35 36 val CloseEnhMetaFile : HDC -> HENHMETAFILE 37 val CloseMetaFile : HDC -> HMETAFILE 38 val CopyEnhMetaFile : HENHMETAFILE * string -> HENHMETAFILE 39 val CopyMetaFile : HMETAFILE * string -> HMETAFILE 40 val CreateEnhMetaFile : 41 HDC * string option * RECT * 42 {pictureName: string, applicationName: string} option -> HDC 43 val CreateMetaFile : string option -> HDC 44 val DeleteEnhMetaFile : HENHMETAFILE -> unit 45 val DeleteMetaFile : HMETAFILE -> unit 46 val GdiComment : HDC * Word8Vector.vector -> unit 47 val GetEnhMetaFile : string -> HENHMETAFILE 48 val GetEnhMetaFileBits : HENHMETAFILE -> Word8Vector.vector 49 val GetEnhMetaFileDescription : 50 HENHMETAFILE -> {pictureName: string, applicationName: string} option 51 val GetEnhMetaFileHeader : HENHMETAFILE -> ENHMETAHEADER 52 val GetMetaFile : string -> HMETAFILE 53 val GetMetaFileBitsEx : HMETAFILE -> Word8Vector.vector 54 val GetWinMetaFileBits : 55 HENHMETAFILE * Transform.MapMode * HDC -> Word8Vector.vector 56 val PlayEnhMetaFile : HDC * HENHMETAFILE * RECT -> unit 57 val PlayMetaFile : HDC * HMETAFILE -> unit 58 val SetEnhMetaFileBits : Word8Vector.vector -> HENHMETAFILE 59 val SetWinMetaFileBits : 60 Word8Vector.vector * HDC * {size: SIZE, mapMode: MapMode} option -> HENHMETAFILE 61 62 end = 63struct 64 local 65 open Foreign Base GdiBase 66 in 67 datatype MapMode = datatype Transform.MapMode 68 type HENHMETAFILE = HENHMETAFILE and HMETAFILE = HMETAFILE 69 type HDC = Base.HDC 70 type SIZE = SIZE and RECT = RECT 71 type METAFILEPICT = METAFILEPICT 72 73 (* TODO: Many of these should check for NULL as a result indicating an error. *) 74 val CloseEnhMetaFile = winCall1 (gdi "CloseEnhMetaFile") (cHDC) cHENHMETAFILE 75 and CloseMetaFile = winCall1 (gdi "CloseMetaFile") (cHDC) cHMETAFILE 76 and CopyEnhMetaFile = winCall2 (gdi "CopyEnhMetaFileA") (cHENHMETAFILE, cString) cHENHMETAFILE 77 and CopyMetaFile = winCall2 (gdi "CopyMetaFileA") (cHMETAFILE, cString) cHMETAFILE 78 and CreateMetaFile = winCall1 (gdi "CreateMetaFileA") (STRINGOPT) cHDC 79 and DeleteEnhMetaFile = 80 winCall1 (gdi "DeleteEnhMetaFile") (cHENHMETAFILE) (successState "DeleteEnhMetaFile") 81 and DeleteMetaFile = winCall1 (gdi "DeleteMetaFile") (cHMETAFILE) (successState "DeleteMetaFile") 82 and GetEnhMetaFile = winCall1 (gdi "GetEnhMetaFileA") (cString) cHENHMETAFILE 83 and GetMetaFile = winCall1 (gdi "GetMetaFileA") (cString) cHMETAFILE 84 and PlayEnhMetaFile = winCall3(gdi "PlayEnhMetaFile") (cHDC, cHENHMETAFILE, cConstStar cRect) 85 (successState "PlayEnhMetaFile") 86 and PlayMetaFile = winCall2(gdi "PlayMetaFile") (cHDC, cHMETAFILE) (successState "PlayMetaFile") 87 88 local 89 val cemf = winCall4 (gdi "CreateEnhMetaFileA") (cHDC, STRINGOPT, cConstStar cRect, cPointer) cHDC 90 in 91 fun CreateEnhMetaFile(hdc, name, r, NONE) = cemf(hdc, name, r, Memory.null) 92 | CreateEnhMetaFile(hdc, name, r, SOME{applicationName, pictureName}) = 93 let 94 val appSize = size applicationName and pictSize = size pictureName 95 open Memory 96 val buff = malloc (Word.fromInt(appSize + pictSize + 3)) 97 in 98 (* The two strings are copied to the buffer with a null between and two 99 nulls at the end. *) 100 copyStringToMem(buff, 0, applicationName); 101 copyStringToMem(buff, appSize+1, pictureName); 102 set8(buff, Word.fromInt(appSize + pictSize + 2), 0w0); 103 (cemf(hdc, name, r, buff) 104 handle ex => (free buff; raise ex)) before free buff 105 end 106 end 107 108 local 109 val gdiComment = winCall3 (gdi "GdiComment") (cHDC, cUint, cPointer) (successState "GdiComment") 110 in 111 fun GdiComment(hdc, v) = 112 let 113 val vecsize = Word8Vector.length v 114 val buff = toCWord8vec v 115 in 116 gdiComment (hdc, vecsize, buff) handle ex => (Memory.free buff; raise ex); 117 Memory.free buff 118 end 119 end 120 121 local 122 val gemfb = winCall3 (gdi "GetEnhMetaFileBits") (cHENHMETAFILE, cUint, cPointer) 123 (cPOSINT "GetEnhMetaFileBits") 124 in 125 fun GetEnhMetaFileBits(hemf: HENHMETAFILE): Word8Vector.vector = 126 let 127 (* Call with a NULL buffer to find out how big it is. *) 128 open Memory 129 val size = gemfb(hemf, 0, Memory.null) 130 val buff = malloc(Word.fromInt size) 131 val res = gemfb(hemf, size, buff) handle ex => (free buff; raise ex) 132 in 133 fromCWord8vec(buff, size) before free buff 134 end 135 end 136 137 local 138 val gemfb = winCall3 (gdi "GetMetaFileBitsEx") (cHMETAFILE, cUint, cPointer) 139 (cPOSINT "GetMetaFileBitsEx") 140 in 141 fun GetMetaFileBitsEx(hemf: HMETAFILE): Word8Vector.vector = 142 let 143 (* Call with a NULL buffer to find out how big it is. *) 144 open Memory 145 val size = gemfb(hemf, 0, Memory.null) 146 val buff = malloc(Word.fromInt size) 147 val res = gemfb(hemf, size, buff) handle ex => (free buff; raise ex) 148 in 149 fromCWord8vec(buff, size) before free buff 150 end 151 end 152 153 154 local 155 val gemfd = winCall3 (gdi "GetEnhMetaFileDescriptionA") (cHENHMETAFILE, cUint, cPointer) cInt 156 (* It's supposed to return a uint but GDI_ERROR is -1 *) 157 in 158 fun GetEnhMetaFileDescription(hemf: HENHMETAFILE) = 159 (* Call with a NULL buffer to find out how big it is. *) 160 case gemfd(hemf, 0, Memory.null) of 161 0 => NONE (* No error - simply no description. *) 162 | len => 163 if len < 0 then raiseSysErr() 164 else 165 let 166 (* The application and picture names are encoded as a pair. *) 167 open Memory 168 infix 6 ++ 169 val buff = malloc (Word.fromInt len) 170 val res = gemfd(hemf, len, buff) 171 val str1 = fromCstring buff 172 val str2 = fromCstring(buff ++ Word.fromInt (size str1 +1)) 173 in 174 SOME {applicationName=str1, pictureName=str2} 175 end 176 end 177 178 local 179 val setEnhMetaFileBits = winCall2 (gdi "SetEnhMetaFileBits") (cUint, cPointer) cHENHMETAFILE 180 in 181 fun SetEnhMetaFileBits(v: Word8Vector.vector): HENHMETAFILE = 182 let 183 val mem = toCWord8vec v 184 in 185 (setEnhMetaFileBits (Word8Vector.length v, mem) 186 handle ex => (Memory.free mem; raise ex)) before Memory.free mem 187 end 188 end 189 190 local 191 val gwmfb = winCall5 (gdi "GetWinMetaFileBits") (cHENHMETAFILE, cUint, cPointer, cMAPMODE, cHDC) 192 (cPOSINT "GetWinMetaFileBits") 193 in 194 fun GetWinMetaFileBits(hemf, mapMode, hdc) = 195 let 196 (* Call with a null pointer to get the size. *) 197 open Memory 198 val size = gwmfb(hemf, 0, null, mapMode, hdc) 199 val buff = malloc (Word.fromInt size) 200 val _ = gwmfb(hemf, size, buff, mapMode, hdc) 201 handle ex => (free buff; raise ex) 202 in 203 fromCWord8vec(buff, size) before free buff 204 end 205 end 206 207 local 208 val swmfb = winCall4 (gdi "SetWinMetaFileBits") (cUint, cPointer, cHDC, cOptionPtr(cConstStar cMETAFILEPICT)) cHENHMETAFILE 209 in 210 fun SetWinMetaFileBits(v, hdc, opts) = 211 let 212 val optmfp = 213 case opts of 214 NONE => NONE 215 | SOME {size, mapMode} => SOME {mm=mapMode, size=size, hMF=hgdiObjNull} 216 val mem = toCWord8vec v 217 in 218 (swmfb(Word8Vector.length v, mem, hdc, optmfp) 219 handle ex => (Memory.free mem; raise ex)) before Memory.free mem 220 end 221 end 222 223 type ENHMETAHEADER = 224 { 225 bounds: RECT, frame: RECT, fileSize: int, records: int, 226 handles: int, palEntries: int, resolutionPixels: SIZE, 227 resolutionMM: SIZE, openGL: bool 228 } 229 230 local 231 val ENHMETAHEADER = cStruct18(cDWORD, cDWORD, cRect, cRect, cDWORD, cDWORD, cDWORD, cDWORD, 232 cWORD, cWORD, cDWORD, cDWORD, cDWORD, cSize, cSize, cDWORD, cDWORD, cDWORD) 233 val {load=toEMH, ...} = breakConversion ENHMETAHEADER 234 val gemf = winCall3 (gdi "GetEnhMetaFileHeader") (cHENHMETAFILE, cUint, cPointer) 235 (cPOSINT "GetEnhMetaFileHeader") 236 in 237 fun GetEnhMetaFileHeader(h: HENHMETAFILE): ENHMETAHEADER = 238 let 239 (* Initial call with a NULL buffer to get size and check the handle. *) 240 open Memory 241 val size = gemf(h, 0, null) 242 val buff = malloc(Word.fromInt size) 243 val _ = gemf(h, size, buff) handle ex => (free buff; raise ex) 244 val (_, _, bounds, frame, _, _, fileSize, records, handles, 245 _, _, _, palEntries, resolutionPixels, resolutionMM, 246 _, _, openGL) = toEMH buff 247 val () = free buff 248 (* Ignore the description and the pixelFormat structure. 249 We can get the description using GetEnhMetaFileDescription. *) 250 in 251 { bounds = bounds, frame = frame, fileSize = fileSize, 252 records = records, handles = handles, palEntries = palEntries, 253 resolutionPixels = resolutionPixels, resolutionMM = resolutionMM, 254 openGL = openGL <> 0 } 255 end 256 end 257 258 (* 259 Other metafile Functions 260 EnhMetaFileProc 261 EnumEnhMetaFile 262 GetEnhMetaFilePaletteEntries 263 PlayEnhMetaFileRecord 264 265 Obsolete Functions 266 EnumMetaFile 267 EnumMetaFileProc 268 PlayMetaFileRecord 269 SetMetaFileBitsEx 270 *) 271 end 272end; 273