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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
|
(*
Copyright (c) 2001, 2015
David C.J. Matthews
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License version 2.1 as published by the Free Software Foundation.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
structure Metafile :
sig
type HENHMETAFILE
type HMETAFILE
type HDC (*= Base.HDC*)
type RECT = { top: int, left: int, bottom: int, right: int }
type SIZE = { cx: int, cy: int }
datatype MapMode = datatype Transform.MapMode
type METAFILEPICT = {mm: MapMode, size: SIZE, hMF: HMETAFILE}
type ENHMETAHEADER =
{
bounds: RECT, frame: RECT, fileSize: int, records: int,
handles: int, palEntries: int, resolutionPixels: SIZE,
resolutionMM: SIZE, openGL: bool
}
val CloseEnhMetaFile : HDC -> HENHMETAFILE
val CloseMetaFile : HDC -> HMETAFILE
val CopyEnhMetaFile : HENHMETAFILE * string -> HENHMETAFILE
val CopyMetaFile : HMETAFILE * string -> HMETAFILE
val CreateEnhMetaFile :
HDC * string option * RECT *
{pictureName: string, applicationName: string} option -> HDC
val CreateMetaFile : string option -> HDC
val DeleteEnhMetaFile : HENHMETAFILE -> unit
val DeleteMetaFile : HMETAFILE -> unit
val GdiComment : HDC * Word8Vector.vector -> unit
val GetEnhMetaFile : string -> HENHMETAFILE
val GetEnhMetaFileBits : HENHMETAFILE -> Word8Vector.vector
val GetEnhMetaFileDescription :
HENHMETAFILE -> {pictureName: string, applicationName: string} option
val GetEnhMetaFileHeader : HENHMETAFILE -> ENHMETAHEADER
val GetMetaFile : string -> HMETAFILE
val GetMetaFileBitsEx : HMETAFILE -> Word8Vector.vector
val GetWinMetaFileBits :
HENHMETAFILE * Transform.MapMode * HDC -> Word8Vector.vector
val PlayEnhMetaFile : HDC * HENHMETAFILE * RECT -> unit
val PlayMetaFile : HDC * HMETAFILE -> unit
val SetEnhMetaFileBits : Word8Vector.vector -> HENHMETAFILE
val SetWinMetaFileBits :
Word8Vector.vector * HDC * {size: SIZE, mapMode: MapMode} option -> HENHMETAFILE
end =
struct
local
open Foreign Base GdiBase
in
datatype MapMode = datatype Transform.MapMode
type HENHMETAFILE = HENHMETAFILE and HMETAFILE = HMETAFILE
type HDC = Base.HDC
type SIZE = SIZE and RECT = RECT
type METAFILEPICT = METAFILEPICT
(* TODO: Many of these should check for NULL as a result indicating an error. *)
val CloseEnhMetaFile = winCall1 (gdi "CloseEnhMetaFile") (cHDC) cHENHMETAFILE
and CloseMetaFile = winCall1 (gdi "CloseMetaFile") (cHDC) cHMETAFILE
and CopyEnhMetaFile = winCall2 (gdi "CopyEnhMetaFileA") (cHENHMETAFILE, cString) cHENHMETAFILE
and CopyMetaFile = winCall2 (gdi "CopyMetaFileA") (cHMETAFILE, cString) cHMETAFILE
and CreateMetaFile = winCall1 (gdi "CreateMetaFileA") (STRINGOPT) cHDC
and DeleteEnhMetaFile =
winCall1 (gdi "DeleteEnhMetaFile") (cHENHMETAFILE) (successState "DeleteEnhMetaFile")
and DeleteMetaFile = winCall1 (gdi "DeleteMetaFile") (cHMETAFILE) (successState "DeleteMetaFile")
and GetEnhMetaFile = winCall1 (gdi "GetEnhMetaFileA") (cString) cHENHMETAFILE
and GetMetaFile = winCall1 (gdi "GetMetaFileA") (cString) cHMETAFILE
and PlayEnhMetaFile = winCall3(gdi "PlayEnhMetaFile") (cHDC, cHENHMETAFILE, cConstStar cRect)
(successState "PlayEnhMetaFile")
and PlayMetaFile = winCall2(gdi "PlayMetaFile") (cHDC, cHMETAFILE) (successState "PlayMetaFile")
local
val cemf = winCall4 (gdi "CreateEnhMetaFileA") (cHDC, STRINGOPT, cConstStar cRect, cPointer) cHDC
in
fun CreateEnhMetaFile(hdc, name, r, NONE) = cemf(hdc, name, r, Memory.null)
| CreateEnhMetaFile(hdc, name, r, SOME{applicationName, pictureName}) =
let
val appSize = size applicationName and pictSize = size pictureName
open Memory
val buff = malloc (Word.fromInt(appSize + pictSize + 3))
in
(* The two strings are copied to the buffer with a null between and two
nulls at the end. *)
copyStringToMem(buff, 0, applicationName);
copyStringToMem(buff, appSize+1, pictureName);
set8(buff, Word.fromInt(appSize + pictSize + 2), 0w0);
(cemf(hdc, name, r, buff)
handle ex => (free buff; raise ex)) before free buff
end
end
local
val gdiComment = winCall3 (gdi "GdiComment") (cHDC, cUint, cPointer) (successState "GdiComment")
in
fun GdiComment(hdc, v) =
let
val vecsize = Word8Vector.length v
val buff = toCWord8vec v
in
gdiComment (hdc, vecsize, buff) handle ex => (Memory.free buff; raise ex);
Memory.free buff
end
end
local
val gemfb = winCall3 (gdi "GetEnhMetaFileBits") (cHENHMETAFILE, cUint, cPointer)
(cPOSINT "GetEnhMetaFileBits")
in
fun GetEnhMetaFileBits(hemf: HENHMETAFILE): Word8Vector.vector =
let
(* Call with a NULL buffer to find out how big it is. *)
open Memory
val size = gemfb(hemf, 0, Memory.null)
val buff = malloc(Word.fromInt size)
val res = gemfb(hemf, size, buff) handle ex => (free buff; raise ex)
in
fromCWord8vec(buff, size) before free buff
end
end
local
val gemfb = winCall3 (gdi "GetMetaFileBitsEx") (cHMETAFILE, cUint, cPointer)
(cPOSINT "GetMetaFileBitsEx")
in
fun GetMetaFileBitsEx(hemf: HMETAFILE): Word8Vector.vector =
let
(* Call with a NULL buffer to find out how big it is. *)
open Memory
val size = gemfb(hemf, 0, Memory.null)
val buff = malloc(Word.fromInt size)
val res = gemfb(hemf, size, buff) handle ex => (free buff; raise ex)
in
fromCWord8vec(buff, size) before free buff
end
end
local
val gemfd = winCall3 (gdi "GetEnhMetaFileDescriptionA") (cHENHMETAFILE, cUint, cPointer) cInt
(* It's supposed to return a uint but GDI_ERROR is -1 *)
in
fun GetEnhMetaFileDescription(hemf: HENHMETAFILE) =
(* Call with a NULL buffer to find out how big it is. *)
case gemfd(hemf, 0, Memory.null) of
0 => NONE (* No error - simply no description. *)
| len =>
if len < 0 then raiseSysErr()
else
let
(* The application and picture names are encoded as a pair. *)
open Memory
infix 6 ++
val buff = malloc (Word.fromInt len)
val res = gemfd(hemf, len, buff)
val str1 = fromCstring buff
val str2 = fromCstring(buff ++ Word.fromInt (size str1 +1))
in
SOME {applicationName=str1, pictureName=str2}
end
end
local
val setEnhMetaFileBits = winCall2 (gdi "SetEnhMetaFileBits") (cUint, cPointer) cHENHMETAFILE
in
fun SetEnhMetaFileBits(v: Word8Vector.vector): HENHMETAFILE =
let
val mem = toCWord8vec v
in
(setEnhMetaFileBits (Word8Vector.length v, mem)
handle ex => (Memory.free mem; raise ex)) before Memory.free mem
end
end
local
val gwmfb = winCall5 (gdi "GetWinMetaFileBits") (cHENHMETAFILE, cUint, cPointer, cMAPMODE, cHDC)
(cPOSINT "GetWinMetaFileBits")
in
fun GetWinMetaFileBits(hemf, mapMode, hdc) =
let
(* Call with a null pointer to get the size. *)
open Memory
val size = gwmfb(hemf, 0, null, mapMode, hdc)
val buff = malloc (Word.fromInt size)
val _ = gwmfb(hemf, size, buff, mapMode, hdc)
handle ex => (free buff; raise ex)
in
fromCWord8vec(buff, size) before free buff
end
end
local
val swmfb = winCall4 (gdi "SetWinMetaFileBits") (cUint, cPointer, cHDC, cOptionPtr(cConstStar cMETAFILEPICT)) cHENHMETAFILE
in
fun SetWinMetaFileBits(v, hdc, opts) =
let
val optmfp =
case opts of
NONE => NONE
| SOME {size, mapMode} => SOME {mm=mapMode, size=size, hMF=hgdiObjNull}
val mem = toCWord8vec v
in
(swmfb(Word8Vector.length v, mem, hdc, optmfp)
handle ex => (Memory.free mem; raise ex)) before Memory.free mem
end
end
type ENHMETAHEADER =
{
bounds: RECT, frame: RECT, fileSize: int, records: int,
handles: int, palEntries: int, resolutionPixels: SIZE,
resolutionMM: SIZE, openGL: bool
}
local
val ENHMETAHEADER = cStruct18(cDWORD, cDWORD, cRect, cRect, cDWORD, cDWORD, cDWORD, cDWORD,
cWORD, cWORD, cDWORD, cDWORD, cDWORD, cSize, cSize, cDWORD, cDWORD, cDWORD)
val {load=toEMH, ...} = breakConversion ENHMETAHEADER
val gemf = winCall3 (gdi "GetEnhMetaFileHeader") (cHENHMETAFILE, cUint, cPointer)
(cPOSINT "GetEnhMetaFileHeader")
in
fun GetEnhMetaFileHeader(h: HENHMETAFILE): ENHMETAHEADER =
let
(* Initial call with a NULL buffer to get size and check the handle. *)
open Memory
val size = gemf(h, 0, null)
val buff = malloc(Word.fromInt size)
val _ = gemf(h, size, buff) handle ex => (free buff; raise ex)
val (_, _, bounds, frame, _, _, fileSize, records, handles,
_, _, _, palEntries, resolutionPixels, resolutionMM,
_, _, openGL) = toEMH buff
val () = free buff
(* Ignore the description and the pixelFormat structure.
We can get the description using GetEnhMetaFileDescription. *)
in
{ bounds = bounds, frame = frame, fileSize = fileSize,
records = records, handles = handles, palEntries = palEntries,
resolutionPixels = resolutionPixels, resolutionMM = resolutionMM,
openGL = openGL <> 0 }
end
end
(*
Other metafile Functions
EnhMetaFileProc
EnumEnhMetaFile
GetEnhMetaFilePaletteEntries
PlayEnhMetaFileRecord
Obsolete Functions
EnumMetaFile
EnumMetaFileProc
PlayMetaFileRecord
SetMetaFileBitsEx
*)
end
end;
|
