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
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
|
(*
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 DeviceContext:
sig
type BITMAP and HDC and HGDIOBJ and HWND and HRGN
type LOGBRUSH = Brush.LOGBRUSH
type LOGFONT = Font.LOGFONT
type LOGPEN = Pen.LOGPEN
type POINT = {x: int, y: int}
type StockObjectType
val ANSI_FIXED_FONT : StockObjectType
val ANSI_VAR_FONT : StockObjectType
val BLACK_BRUSH : StockObjectType
val BLACK_PEN : StockObjectType
val CLR_INVALID : StockObjectType
val DEFAULT_PALETTE : StockObjectType
val DEVICE_DEFAULT_FONT : StockObjectType
val DKGRAY_BRUSH : StockObjectType
val GRAY_BRUSH : StockObjectType
val HOLLOW_BRUSH : StockObjectType
val LTGRAY_BRUSH : StockObjectType
val NULL_BRUSH : StockObjectType
val NULL_PEN : StockObjectType
val OEM_FIXED_FONT : StockObjectType
val SYSTEM_FIXED_FONT : StockObjectType
val SYSTEM_FONT : StockObjectType
val WHITE_BRUSH : StockObjectType
val WHITE_PEN : StockObjectType
val GetStockObject : StockObjectType -> HGDIOBJ
eqtype DeviceItem
val ASPECTX : DeviceItem
val ASPECTXY : DeviceItem
val ASPECTY : DeviceItem
val BITSPIXEL : DeviceItem
val CLIPCAPS : DeviceItem
val COLORRES : DeviceItem
val CURVECAPS : DeviceItem
val DRIVERVERSION : DeviceItem
val HORZRES : DeviceItem
val HORZSIZE : DeviceItem
val LINECAPS : DeviceItem
val LOGPIXELSX : DeviceItem
val LOGPIXELSY : DeviceItem
val NUMBRUSHES : DeviceItem
val NUMCOLORS : DeviceItem
val NUMFONTS : DeviceItem
val NUMMARKERS : DeviceItem
val NUMPENS : DeviceItem
val NUMRESERVED : DeviceItem
val PDEVICESIZE : DeviceItem
val PHYSICALHEIGHT : DeviceItem
val PHYSICALOFFSETX : DeviceItem
val PHYSICALOFFSETY : DeviceItem
val PHYSICALWIDTH : DeviceItem
val PLANES : DeviceItem
val POLYGONALCAPS : DeviceItem
val RASTERCAPS : DeviceItem
val SCALINGFACTORX : DeviceItem
val SCALINGFACTORY : DeviceItem
val SIZEPALETTE : DeviceItem
val TECHNOLOGY : DeviceItem
val TEXTCAPS : DeviceItem
val VERTRES : DeviceItem
val VERTSIZE : DeviceItem
val GetDeviceCaps : HDC * DeviceItem -> int
(* Results of various calls to GetDeviceCaps. Perhaps its result type should
be a union. *)
val CC_CHORD : int
val CC_CIRCLES : int
val CC_ELLIPSES : int
val CC_INTERIORS : int
val CC_NONE : int
val CC_PIE : int
val CC_ROUNDRECT : int
val CC_STYLED : int
val CC_WIDE : int
val CC_WIDESTYLED : int
val CP_NONE : int
val CP_RECTANGLE : int
val CP_REGION : int
val DT_CHARSTREAM : int
val DT_DISPFILE : int
val DT_METAFILE : int
val DT_PLOTTER : int
val DT_RASCAMERA : int
val DT_RASDISPLAY : int
val DT_RASPRINTER : int
val LC_INTERIORS : int
val LC_MARKER : int
val LC_NONE : int
val LC_POLYLINE : int
val LC_POLYMARKER : int
val LC_STYLED : int
val LC_WIDE : int
val LC_WIDESTYLED : int
val PC_INTERIORS : int
val PC_NONE : int
val PC_PATHS : int
val PC_POLYGON : int
val PC_POLYPOLYGON : int
val PC_RECTANGLE : int
val PC_SCANLINE : int
val PC_STYLED : int
val PC_TRAPEZOID : int
val PC_WIDE : int
val PC_WIDESTYLED : int
val PC_WINDPOLYGON : int
val RC_BANDING : int
val RC_BIGFONT : int
val RC_BITBLT : int
val RC_BITMAP64 : int
val RC_DEVBITS : int
val RC_DIBTODEV : int
val RC_DI_BITMAP : int
val RC_FLOODFILL : int
val RC_GDI20_OUTPUT : int
val RC_GDI20_STATE : int
val RC_OP_DX_OUTPUT : int
val RC_PALETTE : int
val RC_SAVEBITMAP : int
val RC_SCALING : int
val RC_STRETCHBLT : int
val RC_STRETCHDIB : int
val TC_CP_STROKE : int
val TC_CR_90 : int
val TC_CR_ANY : int
val TC_EA_DOUBLE : int
val TC_IA_ABLE : int
val TC_OP_CHARACTER : int
val TC_OP_STROKE : int
val TC_RA_ABLE : int
val TC_RESERVED : int
val TC_SA_CONTIN : int
val TC_SA_DOUBLE : int
val TC_SA_INTEGER : int
val TC_SCROLLBLT : int
val TC_SF_X_YINDEP : int
val TC_SO_ABLE : int
val TC_UA_ABLE : int
val TC_VA_ABLE : int
datatype DMColor = DMCOLOR_COLOR | DMCOLOR_MONOCHROME
and DMDither =
DMDITHER_COARSE
| DMDITHER_FINE
| DMDITHER_GRAYSCALE
| DMDITHER_LINEART
| DMDITHER_NONE
| DMDITHER_OTHER of int
and DMDuplex = DMDUP_HORIZONTAL | DMDUP_SIMPLEX | DMDUP_VERTICAL
and DMICMIntent =
DMICMINTENT_OTHER of int
| DMICM_COLORMETRIC
| DMICM_CONTRAST
| DMICM_SATURATE
and DMICMMethod =
DMICMMETHOD_DEVICE
| DMICMMETHOD_DRIVER
| DMICMMETHOD_NONE
| DMICMMETHOD_OTHER of int
| DMICMMETHOD_SYSTEM
and DMMedia =
DMICMMEDIA_OTHER of int
| DMMEDIA_GLOSSY
| DMMEDIA_STANDARD
| DMMEDIA_TRANSPARENCY
and DMOrientation = DMORIENT_LANDSCAPE | DMORIENT_PORTRAIT
and DMPaperSize =
DMPAPER_10X11
| DMPAPER_10X14
| DMPAPER_11X17
| DMPAPER_15X11
| DMPAPER_9X11
| DMPAPER_A2
| DMPAPER_A3
| DMPAPER_A3_EXTRA
| DMPAPER_A3_EXTRA_TRANSVERSE
| DMPAPER_A3_TRANSVERSE
| DMPAPER_A4
| DMPAPER_A4SMALL
| DMPAPER_A4_EXTRA
| DMPAPER_A4_PLUS
| DMPAPER_A4_TRANSVERSE
| DMPAPER_A5
| DMPAPER_A5_EXTRA
| DMPAPER_A5_TRANSVERSE
| DMPAPER_A_PLUS
| DMPAPER_B4
| DMPAPER_B5
| DMPAPER_B5_EXTRA
| DMPAPER_B5_TRANSVERSE
| DMPAPER_B_PLUS
| DMPAPER_CSHEET
| DMPAPER_DSHEET
| DMPAPER_ENV_10
| DMPAPER_ENV_11
| DMPAPER_ENV_12
| DMPAPER_ENV_14
| DMPAPER_ENV_9
| DMPAPER_ENV_B4
| DMPAPER_ENV_B5
| DMPAPER_ENV_B6
| DMPAPER_ENV_C3
| DMPAPER_ENV_C4
| DMPAPER_ENV_C5
| DMPAPER_ENV_C6
| DMPAPER_ENV_C65
| DMPAPER_ENV_DL
| DMPAPER_ENV_INVITE
| DMPAPER_ENV_ITALY
| DMPAPER_ENV_MONARCH
| DMPAPER_ENV_PERSONAL
| DMPAPER_ESHEET
| DMPAPER_EXECUTIVE
| DMPAPER_FANFOLD_LGL_GERMAN
| DMPAPER_FANFOLD_STD_GERMAN
| DMPAPER_FANFOLD_US
| DMPAPER_FOLIO
| DMPAPER_ISO_B4
| DMPAPER_JAPANESE_POSTCARD
| DMPAPER_LEDGER
| DMPAPER_LEGAL
| DMPAPER_LEGAL_EXTRA
| DMPAPER_LETTER
| DMPAPER_LETTERSMALL
| DMPAPER_LETTER_EXTRA
| DMPAPER_LETTER_EXTRA_TRANSVERSE
| DMPAPER_LETTER_PLUS
| DMPAPER_LETTER_TRANSVERSE
| DMPAPER_NOTE
| DMPAPER_OTHER of int
| DMPAPER_QUARTO
| DMPAPER_RESERVED_48
| DMPAPER_RESERVED_49
| DMPAPER_STATEMENT
| DMPAPER_TABLOID
| DMPAPER_TABLOID_EXTRA
and DMResolution =
DMRES_DPI of int
| DMRES_DRAFT
| DMRES_HIGH
| DMRES_LOW
| DMRES_MEDIUM
and DMSource =
DMBIN_AUTO
| DMBIN_CASSETTE
| DMBIN_ENVELOPE
| DMBIN_ENVMANUAL
| DMBIN_FORMSOURCE
| DMBIN_LARGECAPACITY
| DMBIN_LARGEFMT
| DMBIN_LOWER
| DMBIN_MANUAL
| DMBIN_MIDDLE
| DMBIN_ONLYONE
| DMBIN_SMALLFMT
| DMBIN_TRACTOR
| DMBIN_UPPER
| DMSOURCE_OTHER of int
and DMTrueType =
DMTT_BITMAP
| DMTT_DOWNLOAD
| DMTT_DOWNLOAD_OUTLINE
| DMTT_SUBDEV
type DEVMODE = {
deviceName: string,
driverVersion: int,
orientation: DMOrientation option,
paperSize: DMPaperSize option,
paperLength: int option,
paperWidth: int option,
scale: int option,
copies: int option,
defaultSource: DMSource option,
printQuality: DMResolution option,
color: DMColor option,
duplex: DMDuplex option,
yResolution: int option,
ttOption: DMTrueType option,
collate: bool option,
formName: string option,
logPixels: int option,
bitsPerPixel: int option,
pelsWidth: int option,
pelsHeight: int option,
displayFlags: int option, (* Apparently no longer used. *)
displayFrequency: int option,
icmMethod: DMICMMethod option,
icmIntent: DMICMIntent option,
mediaType: DMMedia option,
ditherType: DMDither option,
panningWidth: int option,
panningHeight: int option,
driverPrivate: Word8Vector.vector
}
val CancelDC : HDC -> unit
val CreateCompatibleDC : HDC -> HDC
val CreateDC : string option * string option * string option * DEVMODE option -> HDC
val DeleteDC : HDC -> unit
val DeleteObject : HGDIOBJ -> unit
datatype
EnumObject =
OBJ_BITMAP
| OBJ_BRUSH
| OBJ_DC
| OBJ_ENHMETADC
| OBJ_ENHMETAFILE
| OBJ_EXTPEN
| OBJ_FONT
| OBJ_MEMDC
| OBJ_METADC
| OBJ_METAFILE
| OBJ_PAL
| OBJ_PEN
| OBJ_REGION
val GetCurrentObject : HDC * EnumObject -> HGDIOBJ
val GetDC : HWND -> HDC
datatype
DeviceContextFlag =
DCX_CACHE
| DCX_CLIPCHILDREN
| DCX_CLIPSIBLINGS
| DCX_EXCLUDERGN
| DCX_EXCLUDEUPDATE
| DCX_INTERSECTRGN
| DCX_INTERSECTUPDATE
| DCX_LOCKWINDOWUPDATE
| DCX_NORECOMPUTE
| DCX_NORESETATTRS
| DCX_PARENTCLIP
| DCX_VALIDATE
| DCX_WINDOW
val GetDCEx : HWND * HRGN * DeviceContextFlag list -> HDC
val GetDCOrgEx : HDC -> POINT
datatype
GetObject =
GO_Bitmap of BITMAP
| GO_Brush of LOGBRUSH
| GO_Font of LOGFONT
| GO_Palette of int
| GO_Pen of LOGPEN
val GetObject : HGDIOBJ -> GetObject
val GetObjectType : HGDIOBJ -> EnumObject
val ReleaseDC : HWND * HDC -> bool
val ResetDC : HDC * DEVMODE -> HDC
val RestoreDC : HDC * int -> unit
val SaveDC : HDC -> int
val SelectObject : HDC * HGDIOBJ -> HGDIOBJ
type DEVNAMES = {driver: string, device: string, output: string, default: bool}
end
=
struct
local
open Foreign Base
fun checkDC c = (checkResult(not(isHdcNull c)); c)
in
type HDC = HDC and HGDIOBJ = HGDIOBJ and HWND = HWND and HRGN = HRGN
type LOGFONT = Font.LOGFONT
open GdiBase DeviceBase
type POINT = POINT
datatype DeviceContextFlag =
DCX_WINDOW | DCX_CACHE | DCX_NORESETATTRS | DCX_CLIPCHILDREN | DCX_CLIPSIBLINGS |
DCX_PARENTCLIP | DCX_EXCLUDERGN | DCX_INTERSECTRGN | DCX_EXCLUDEUPDATE | DCX_INTERSECTUPDATE |
DCX_LOCKWINDOWUPDATE | DCX_NORECOMPUTE | DCX_VALIDATE
local
val tab = [
(DCX_WINDOW, 0wx00000001),
(DCX_CACHE, 0wx00000002),
(DCX_NORESETATTRS, 0wx00000004),
(DCX_CLIPCHILDREN, 0wx00000008),
(DCX_CLIPSIBLINGS, 0wx00000010),
(DCX_PARENTCLIP, 0wx00000020),
(DCX_EXCLUDERGN, 0wx00000040),
(DCX_INTERSECTRGN, 0wx00000080),
(DCX_EXCLUDEUPDATE, 0wx00000100),
(DCX_INTERSECTUPDATE, 0wx00000200),
(DCX_LOCKWINDOWUPDATE, 0wx00000400),
(DCX_NORECOMPUTE, 0wx00100000),
(DCX_VALIDATE, 0wx00200000)]
in
val DEVICECONTEXTFLAG = tableSetConversion(tab, NONE)
end
(* DEVNAMES is not actually used in this structure. *)
type DEVNAMES = {driver: string, device: string, output: string, default: bool}
datatype EnumObject = OBJ_PEN | OBJ_BRUSH | OBJ_DC | OBJ_METADC | OBJ_PAL | OBJ_FONT |
OBJ_BITMAP | OBJ_REGION | OBJ_METAFILE | OBJ_MEMDC | OBJ_EXTPEN | OBJ_ENHMETADC |
OBJ_ENHMETAFILE
local
val tab = [
(OBJ_PEN, 1),
(OBJ_BRUSH, 2),
(OBJ_DC, 3),
(OBJ_METADC, 4),
(OBJ_PAL, 5),
(OBJ_FONT, 6),
(OBJ_BITMAP, 7),
(OBJ_REGION, 8),
(OBJ_METAFILE, 9),
(OBJ_MEMDC, 10),
(OBJ_EXTPEN, 11),
(OBJ_ENHMETADC, 12),
(OBJ_ENHMETAFILE, 13)
]
datatype EnumObject =
W of int
(* GetObjectType returns 0 in the event of an error. *)
fun toInt _ = raise Match
fun fromInt i = (checkResult(i <> 0); raise Match);
in
val ENUMOBJECT = tableConversion(tab, SOME(fromInt, toInt)) cUint
end
local
datatype DeviceItem =
W of int
in
type DeviceItem = DeviceItem
val DEVICEITEM = absConversion {abs = W, rep = fn W n => n} cInt
val DRIVERVERSION = W (0 (* Device driver version *))
val TECHNOLOGY = W (2 (* Device classification *))
val HORZSIZE = W (4 (* Horizontal size in millimeters *))
val VERTSIZE = W (6 (* Vertical size in millimeters *))
val HORZRES = W (8 (* Horizontal width in pixels *))
val VERTRES = W (10 (* Vertical width in pixels *))
val BITSPIXEL = W (12 (* Number of bits per pixel *))
val PLANES = W (14 (* Number of planes *))
val NUMBRUSHES = W (16 (* Number of brushes the device has *))
val NUMPENS = W (18 (* Number of pens the device has *))
val NUMMARKERS = W (20 (* Number of markers the device has *))
val NUMFONTS = W (22 (* Number of fonts the device has *))
val NUMCOLORS = W (24 (* Number of colors the device supports *))
val PDEVICESIZE = W (26 (* Size required for device descriptor *))
val CURVECAPS = W (28 (* Curve capabilities *))
val LINECAPS = W (30 (* Line capabilities *))
val POLYGONALCAPS = W (32 (* Polygonal capabilities *))
val TEXTCAPS = W (34 (* Text capabilities *))
val CLIPCAPS = W (36 (* Clipping capabilities *))
val RASTERCAPS = W (38 (* Bitblt capabilities *))
val ASPECTX = W (40 (* Length of the X leg *))
val ASPECTY = W (42 (* Length of the Y leg *))
val ASPECTXY = W (44 (* Length of the hypotenuse *))
val LOGPIXELSX = W (88 (* Logical pixels/inch in X *))
val LOGPIXELSY = W (90 (* Logical pixels/inch in Y *))
val SIZEPALETTE = W (104 (* Number of entries in physical palette *))
val NUMRESERVED = W (106 (* Number of reserved entries in palette *))
val COLORRES = W (108 (* Actual color resolution *))
val PHYSICALWIDTH = W (110 (* Physical Width in device units *))
val PHYSICALHEIGHT = W (111 (* Physical Height in device units *))
val PHYSICALOFFSETX = W (112 (* Physical Printable Area x margin *))
val PHYSICALOFFSETY = W (113 (* Physical Printable Area y margin *))
val SCALINGFACTORX = W (114 (* Scaling factor x *))
val SCALINGFACTORY = W (115 (* Scaling factor y *))
end
(* Results of GetDeviceCaps. Since it returns an int all these are simply ints. *)
val DT_PLOTTER = 0 (* Vector plotter *)
val DT_RASDISPLAY = 1 (* Raster display *)
val DT_RASPRINTER = 2 (* Raster printer *)
val DT_RASCAMERA = 3 (* Raster camera *)
val DT_CHARSTREAM = 4 (* Character-stream, PLP *)
val DT_METAFILE = 5 (* Metafile, VDM *)
val DT_DISPFILE = 6 (* Display-file *)
(* Curve Capabilities *)
val CC_NONE = 0 (* Curves not supported *)
val CC_CIRCLES = 1 (* Can do circles *)
val CC_PIE = 2 (* Can do pie wedges *)
val CC_CHORD = 4 (* Can do chord arcs *)
val CC_ELLIPSES = 8 (* Can do ellipese *)
val CC_WIDE = 16 (* Can do wide lines *)
val CC_STYLED = 32 (* Can do styled lines *)
val CC_WIDESTYLED = 64 (* Can do wide styled lines *)
val CC_INTERIORS = 128 (* Can do interiors *)
val CC_ROUNDRECT = 256 (* *)
(* Line Capabilities *)
val LC_NONE = 0 (* Lines not supported *)
val LC_POLYLINE = 2 (* Can do polylines *)
val LC_MARKER = 4 (* Can do markers *)
val LC_POLYMARKER = 8 (* Can do polymarkers *)
val LC_WIDE = 16 (* Can do wide lines *)
val LC_STYLED = 32 (* Can do styled lines *)
val LC_WIDESTYLED = 64 (* Can do wide styled lines *)
val LC_INTERIORS = 128 (* Can do interiors *)
(* Polygonal Capabilities *)
val PC_NONE = 0 (* Polygonals not supported *)
val PC_POLYGON = 1 (* Can do polygons *)
val PC_RECTANGLE = 2 (* Can do rectangles *)
val PC_WINDPOLYGON = 4 (* Can do winding polygons *)
val PC_TRAPEZOID = 4 (* Can do trapezoids *)
val PC_SCANLINE = 8 (* Can do scanlines *)
val PC_WIDE = 16 (* Can do wide borders *)
val PC_STYLED = 32 (* Can do styled borders *)
val PC_WIDESTYLED = 64 (* Can do wide styled borders *)
val PC_INTERIORS = 128 (* Can do interiors *)
val PC_POLYPOLYGON = 256 (* Can do polypolygons *)
val PC_PATHS = 512 (* Can do paths *)
(* Clipping Capabilities *)
val CP_NONE = 0 (* No clipping of output *)
val CP_RECTANGLE = 1 (* Output clipped to rects *)
val CP_REGION = 2 (* obsolete *)
(* Text Capabilities *)
val TC_OP_CHARACTER = 0x00000001 (* Can do OutputPrecision CHARACTER *)
val TC_OP_STROKE = 0x00000002 (* Can do OutputPrecision STROKE *)
val TC_CP_STROKE = 0x00000004 (* Can do ClipPrecision STROKE *)
val TC_CR_90 = 0x00000008 (* Can do CharRotAbility 90 *)
val TC_CR_ANY = 0x00000010 (* Can do CharRotAbility ANY *)
val TC_SF_X_YINDEP = 0x00000020 (* Can do ScaleFreedom X_YINDEPENDENT *)
val TC_SA_DOUBLE = 0x00000040 (* Can do ScaleAbility DOUBLE *)
val TC_SA_INTEGER = 0x00000080 (* Can do ScaleAbility INTEGER *)
val TC_SA_CONTIN = 0x00000100 (* Can do ScaleAbility CONTINUOUS *)
val TC_EA_DOUBLE = 0x00000200 (* Can do EmboldenAbility DOUBLE *)
val TC_IA_ABLE = 0x00000400 (* Can do ItalisizeAbility ABLE *)
val TC_UA_ABLE = 0x00000800 (* Can do UnderlineAbility ABLE *)
val TC_SO_ABLE = 0x00001000 (* Can do StrikeOutAbility ABLE *)
val TC_RA_ABLE = 0x00002000 (* Can do RasterFontAble ABLE *)
val TC_VA_ABLE = 0x00004000 (* Can do VectorFontAble ABLE *)
val TC_RESERVED = 0x00008000
val TC_SCROLLBLT = 0x00010000 (* Don't do text scroll with blt *)
(* Raster Capabilities *)
val RC_BITBLT = 1 (* Can do standard BLT. *)
val RC_BANDING = 2 (* Device requires banding support *)
val RC_SCALING = 4 (* Device requires scaling support *)
val RC_BITMAP64 = 8 (* Device can support >64K bitmap *)
val RC_GDI20_OUTPUT = 0x0010 (* has 2.0 output calls *)
val RC_GDI20_STATE = 0x0020
val RC_SAVEBITMAP = 0x0040
val RC_DI_BITMAP = 0x0080 (* supports DIB to memory *)
val RC_PALETTE = 0x0100 (* supports a palette *)
val RC_DIBTODEV = 0x0200 (* supports DIBitsToDevice *)
val RC_BIGFONT = 0x0400 (* supports >64K fonts *)
val RC_STRETCHBLT = 0x0800 (* supports StretchBlt *)
val RC_FLOODFILL = 0x1000 (* supports FloodFill *)
val RC_STRETCHDIB = 0x2000 (* supports StretchDIBits *)
val RC_OP_DX_OUTPUT = 0x4000
val RC_DEVBITS = 0x8000
local
datatype StockObjectType =
W of int
in
type StockObjectType = StockObjectType
val STOCKOBJECTTYPE = absConversion {abs = W, rep = fn W n => n} cInt
val WHITE_BRUSH = W (0)
val LTGRAY_BRUSH = W (1)
val GRAY_BRUSH = W (2)
val DKGRAY_BRUSH = W (3)
val BLACK_BRUSH = W (4)
val NULL_BRUSH = W (5)
val HOLLOW_BRUSH = NULL_BRUSH
val WHITE_PEN = W (6)
val BLACK_PEN = W (7)
val NULL_PEN = W (8)
val OEM_FIXED_FONT = W (10)
val ANSI_FIXED_FONT = W (11)
val ANSI_VAR_FONT = W (12)
val SYSTEM_FONT = W (13)
val DEVICE_DEFAULT_FONT = W (14)
val DEFAULT_PALETTE = W (15)
val SYSTEM_FIXED_FONT = W (16)
(*val STOCK_LAST = W (16)*)
val CLR_INVALID = W (0xFFFFFFFF)
end
val CancelDC = winCall1(gdi "CancelDC") (cHDC) (successState "CancelDC")
val CreateCompatibleDC = winCall1(gdi "CreateCompatibleDC") (cHDC) cHDC
val DeleteDC = winCall1(gdi "DeleteDC") (cHDC) (successState "DeleteDC")
val DeleteObject = winCall1(gdi "DeleteObject") (cHGDIOBJ) (successState "DeleteObject")
val GetCurrentObject = winCall2(gdi "GetCurrentObject") (cHDC,ENUMOBJECT) cHGDIOBJ
val GetDC = checkDC o winCall1(user "GetDC") (cHWND) cHDC
val GetDCEx = checkDC o winCall3(user "GetDCEx") (cHWND,cHRGN,DEVICECONTEXTFLAG) cHDC
local
val getDCOrgEx = winCall2(gdi "GetDCOrgEx") (cHDC, cStar cPoint) (successState "GetDCOrgEx")
in
fun GetDCOrgEx hdc = let val v = ref {x=0, y=0} in getDCOrgEx(hdc, v); !v end
end
val GetDeviceCaps = winCall2(gdi "GetDeviceCaps") (cHDC,DEVICEITEM) cInt
val GetObjectType = winCall1(gdi "GetObjectType") (cHGDIOBJ) ENUMOBJECT
val GetStockObject = winCall1 (gdi "GetStockObject") (STOCKOBJECTTYPE) cHGDIOBJ
val ReleaseDC = winCall2(user "ReleaseDC") (cHWND,cHDC) cBool
val RestoreDC = winCall2(gdi "RestoreDC") (cHDC,cInt) (successState "RestoreDC")
val SaveDC = winCall1(gdi "SaveDC") (cHDC) cInt
val ResetDC = winCall2 (gdi "ResetDC") (cHDC, LPDEVMODE) cHDC
(* The result of SelectObject is a bit of a mess. It is the original object being
replaced except if the argument is a region when it returns a RESULTREGION.
Perhaps we need a different function for that. *)
val SelectObject = winCall2(gdi "SelectObject") (cHDC,cHGDIOBJ) cHGDIOBJ
val CreateDC = winCall4 (gdi "CreateDCA") (STRINGOPT, STRINGOPT, STRINGOPT, cOptionPtr LPDEVMODE) cHDC
(* GetObject returns information about different kinds of GDI object.
It takes a pointer to a structure whose size and format differ according
to the type of object. To implement this properly in ML we have to
find out the type before we start. *)
datatype GetObject =
GO_Bitmap of BITMAP
(*| GO_DIBSection of DIBSECTION*) (* This is a subset of BITMAP *)
(*| GO_ExPen of EXTLOGPEN*)
| GO_Brush of LOGBRUSH
| GO_Font of LOGFONT
| GO_Pen of LOGPEN
| GO_Palette of int
local
val getObj = winCall3 (gdi "GetObjectA") (cHGDIOBJ, cInt, cPointer) cInt
val {load=fromCBM, ...} = breakConversion cBITMAP
val {load=fromCLF, ...} = breakConversion FontBase.cLOGFONT
val {load=fromCLB, ...} = breakConversion cLOGBRUSH
val {load=fromCLP, ...} = breakConversion cLOGPEN
val {load=fromCshort, ...} = breakConversion cShort
in
fun GetObject(hgdi: HGDIOBJ): GetObject =
let
(* Call with a NULL buffer to find out the memory required. Also
checks the GDI object. *)
open Memory
val space = getObj(hgdi, 0, Memory.null)
val _ = checkResult(space > 0);
val mem = malloc (Word.fromInt space)
val _ =
getObj(hgdi, space, mem) handle ex => (free mem; raise ex)
in
(case GetObjectType hgdi of
OBJ_PEN => GO_Pen(fromCLP mem)
| OBJ_BRUSH => GO_Brush(fromCLB mem)
| OBJ_BITMAP => GO_Bitmap(fromCBM mem)
| OBJ_FONT => GO_Font(fromCLF mem)
(*| OBJ_EXPEN => *) (* TODO!!*)
| OBJ_PAL => GO_Palette(fromCshort mem) (* Number of entries. *)
| _ => raise Fail "Different type")
before free mem
end
end
(*
Other Device context functions:
ChangeDisplaySettings
ChangeDisplaySettingsEx
CreateIC
DeviceCapabilities
DrawEscape
EnumDisplayDevices
EnumDisplaySettings
EnumObjects
EnumObjectsProc
GetDCBrushColor - NT 5.0 and Win 98 only
GetDCPenColor - NT 5.0 and Win 98 only
SetDCBrushColor - NT 5.0 and Win 98 only
SetDCPenColor - NT 5.0 and Win 98 only
*)
end
end;
|
