(*
    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;
