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 Painting :
20  sig
21    type HWND and HDC and COLORREF and HRGN
22
23    type RECT = { top: int, left: int, bottom: int, right: int }
24
25    type BinaryRasterOperation
26    val R2_BLACK : BinaryRasterOperation
27    val R2_COPYPEN : BinaryRasterOperation
28    val R2_MASKNOTPEN : BinaryRasterOperation
29    val R2_MASKPEN : BinaryRasterOperation
30    val R2_MASKPENNOT : BinaryRasterOperation
31    val R2_MERGENOTPEN : BinaryRasterOperation
32    val R2_MERGEPEN : BinaryRasterOperation
33    val R2_MERGEPENNOT : BinaryRasterOperation
34    val R2_NOP : BinaryRasterOperation
35    val R2_NOT : BinaryRasterOperation
36    val R2_NOTCOPYPEN : BinaryRasterOperation
37    val R2_NOTMASKPEN : BinaryRasterOperation
38    val R2_NOTMERGEPEN : BinaryRasterOperation
39    val R2_NOTXORPEN : BinaryRasterOperation
40    val R2_WHITE : BinaryRasterOperation
41    val R2_XORPEN : BinaryRasterOperation
42
43    type PAINTSTRUCT =
44        { hdc: HDC, erase: bool, paint: RECT, private: Word8Vector.vector }
45
46    val BeginPaint : HWND -> HDC * PAINTSTRUCT
47    val EndPaint : HWND * PAINTSTRUCT -> unit
48    val GdiFlush : unit -> unit
49    val GdiGetBatchLimit : unit -> int
50    val GdiSetBatchLimit : int -> int
51    val GetBkColor : HDC -> COLORREF
52    val GetROP2 : HDC -> BinaryRasterOperation
53    val GetUpdateRect : HWND * bool -> RECT option
54    val GetUpdateRgn : HWND * HRGN * bool -> Region.ResultRegion
55    val GetWindowDC : HWND -> HDC
56    val InvalidateRgn : HWND * HRGN * bool -> unit
57    val SetBkColor : HDC * COLORREF -> COLORREF
58    val SetROP2 : HDC * BinaryRasterOperation -> BinaryRasterOperation
59    val WindowFromDC : HDC -> HWND
60    val InvalidateRect: HWND * RECT * bool -> unit
61  end =
62struct
63    local
64        open Foreign Base GdiBase
65
66        fun checkDC c = (checkResult(not(isHdcNull c)); c)
67        val zeroRect:RECT = {top=0, bottom=0, left=0, right=0}
68    in
69        type ResultRegion = Region.ResultRegion
70        type HDC = HDC and HRGN = HRGN and HWND = HWND
71        type RECT = RECT and COLORREF = COLORREF
72
73        (* GetROP2 and SetROP2. *)
74        local
75            datatype BinaryRasterOperation =
76            W of int
77        in
78            type BinaryRasterOperation = BinaryRasterOperation
79            val BINARYRASTEROPERATION = absConversion {abs = W, rep = fn W n => n} cInt
80        
81            val R2_BLACK                                     = W (1 (* 0 *))
82            val R2_NOTMERGEPEN                               = W (2 (* DPon *))
83            val R2_MASKNOTPEN                                = W (3 (* DPna *))
84            val R2_NOTCOPYPEN                                = W (4 (* PN *))
85            val R2_MASKPENNOT                                = W (5 (* PDna *))
86            val R2_NOT                                       = W (6 (* Dn *))
87            val R2_XORPEN                                    = W (7 (* DPx *))
88            val R2_NOTMASKPEN                                = W (8 (* DPan *))
89            val R2_MASKPEN                                   = W (9 (* DPa *))
90            val R2_NOTXORPEN                                 = W (10 (* DPxn *))
91            val R2_NOP                                       = W (11 (* D *))
92            val R2_MERGENOTPEN                               = W (12 (* DPno *))
93            val R2_COPYPEN                                   = W (13 (* P *))
94            val R2_MERGEPENNOT                               = W (14 (* PDno *))
95            val R2_MERGEPEN                                  = W (15 (* DPo *))
96            val R2_WHITE                                     = W (16 (* 1 *))
97        end
98
99        val GdiFlush               = winCall0 (gdi "GdiFlush") () (successState "GdiFlush")
100        val GdiGetBatchLimit       = winCall0 (gdi "GdiGetBatchLimit") () cDWORD
101        val GdiSetBatchLimit       = winCall1 (gdi "GdiSetBatchLimit") (cDWORD) cDWORD
102        val GetBkColor             = winCall1 (gdi "GetBkColor") (cHDC) cCOLORREF
103        val GetROP2                = winCall1(user "GetROP2") (cHDC) BINARYRASTEROPERATION
104        val GetUpdateRgn           = winCall3(user "GetUpdateRgn") (cHWND,cHRGN,cBool) RESULTREGION
105        val GetWindowDC            = winCall1(user "GetWindowDC") (cHWND) cHDC
106        val InvalidateRgn          = winCall3(user "InvalidateRgn") (cHWND,cHRGN,cBool) (successState "InvalidateRgn")
107        val InvalidateRect =
108            winCall3 (user "InvalidateRect") (cHWND, cConstStar cRect, cBool) (successState "InvalidateRect")
109        val SetBkColor             = winCall2 (gdi "SetBkColor") (cHDC, cCOLORREF) cCOLORREF
110        val WindowFromDC           = winCall1(user "WindowFromDC") (cHDC) cHWND
111        val SetROP2                = winCall2(user "SetROP2") (cHDC, BINARYRASTEROPERATION) BINARYRASTEROPERATION
112
113        local
114            val getUpdateRect = winCall3 (user "GetUpdateRect") (cHWND, cStar cRect, cBool) cBool
115        in
116            fun GetUpdateRect (hw: HWND, erase: bool): RECT option =
117            let
118                val va = ref zeroRect
119                (* If the update area is empty the result is zero. *)
120                val res = getUpdateRect(hw, va, erase)
121            in
122                if res then SOME(!va) else NONE
123            end
124        end
125
126        type PAINTSTRUCT =
127            { hdc: HDC, erase: bool, paint: RECT, private: Word8Vector.vector }
128
129        local
130            fun toPt({hdc, erase, paint, private}: PAINTSTRUCT) =
131                (hdc, erase, paint, Byte.bytesToString private)
132            and fromPt(hdc, erase, paint, private) =
133                {hdc = hdc, erase = erase, paint = paint, private = Byte.stringToBytes private}
134            val PAINTSTRUCT =
135                absConversion {abs=fromPt, rep=toPt} (cStruct4(cHDC, cBool, cRect, cCHARARRAY 40))
136
137            val beginPaint = winCall2 (user "BeginPaint") (cHWND, cStar PAINTSTRUCT) cHDC
138        in
139            fun BeginPaint(hwnd: HWND): HDC * PAINTSTRUCT =
140            let
141                val b = ref {hdc=hNull, erase=false, paint=zeroRect, private=Word8Vector.fromList []}
142                val hdc = checkDC (beginPaint (hwnd, b))
143            in
144                (hdc, !b)
145            end
146
147            val EndPaint = winCall2 (user "EndPaint") (cHWND, cConstStar PAINTSTRUCT) cVoid
148        end
149        (*
150            Other painting and drawing functions:
151                DrawAnimatedRects  
152                DrawCaption  
153                DrawEdge  
154                DrawFocusRect  
155                DrawFrameControl  
156                DrawState  
157                DrawStateProc  
158                ExcludeUpdateRgn  
159                GetBkMode  
160                GetBoundsRect  
161                GetWindowRgn  
162                GrayString  
163                LockWindowUpdate  
164                OutputProc  
165                PaintDesktop  
166                RedrawWindow  
167                SetBkMode  
168                SetBoundsRect  
169                SetWindowRgn  
170                UpdateWindow  
171                ValidateRect  
172                ValidateRgn  
173        *)
174
175    end
176end;
177