1(*
2    Copyright (c) 2001-7, 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
19(* This contains the types used in the Win structure.  *)
20structure WinBase =
21struct
22    local
23        open Foreign Base
24    in
25
26        structure Style :>
27        sig
28            include BIT_FLAGS
29            val WS_BORDER : flags
30            val WS_CAPTION : flags
31            val WS_CHILD : flags
32            val WS_CHILDWINDOW : flags
33            val WS_CLIPCHILDREN : flags
34            val WS_CLIPSIBLINGS : flags
35            val WS_DISABLED : flags
36            val WS_DLGFRAME : flags
37            val WS_GROUP : flags
38            val WS_HSCROLL : flags
39            val WS_ICONIC : flags
40            val WS_MAXIMIZE : flags
41            val WS_MAXIMIZEBOX : flags
42            val WS_MINIMIZE : flags
43            val WS_MINIMIZEBOX : flags
44            val WS_OVERLAPPED : flags
45            val WS_OVERLAPPEDWINDOW : flags
46            val WS_POPUP : flags
47            val WS_POPUPWINDOW : flags
48            val WS_SIZEBOX : flags
49            val WS_SYSMENU : flags
50            val WS_TABSTOP : flags
51            val WS_THICKFRAME : flags
52            val WS_TILED : flags
53            val WS_TILEDWINDOW : flags
54            val WS_VISIBLE : flags
55            val WS_VSCROLL : flags
56        end =
57        struct
58            type flags = SysWord.word
59            fun toWord f = f
60            fun fromWord f = f
61            val flags = List.foldl (fn (a, b) => SysWord.orb(a,b)) 0w0
62            fun allSet (fl1, fl2) = SysWord.andb(fl1, fl2) = fl1
63            fun anySet (fl1, fl2) = SysWord.andb(fl1, fl2) <> 0w0
64            fun clear (fl1, fl2) = SysWord.andb(SysWord.notb fl1, fl2)
65    
66            (* Window styles. *)
67            val WS_OVERLAPPED: flags                         = 0wx00000000
68            val WS_POPUP: flags                              = 0wx80000000
69            val WS_CHILD: flags                              = 0wx40000000
70            val WS_MINIMIZE: flags                           = 0wx20000000
71            val WS_VISIBLE: flags                            = 0wx10000000
72            val WS_DISABLED: flags                           = 0wx08000000
73            val WS_CLIPSIBLINGS: flags                       = 0wx04000000
74            val WS_CLIPCHILDREN: flags                       = 0wx02000000
75            val WS_MAXIMIZE: flags                           = 0wx01000000
76            val WS_CAPTION: flags                            = 0wx00C00000 (* WS_BORDER | WS_DLGFRAME *)
77            val WS_BORDER: flags                             = 0wx00800000
78            val WS_DLGFRAME: flags                           = 0wx00400000
79            val WS_VSCROLL: flags                            = 0wx00200000
80            val WS_HSCROLL: flags                            = 0wx00100000
81            val WS_SYSMENU: flags                            = 0wx00080000
82            val WS_THICKFRAME: flags                         = 0wx00040000
83            val WS_GROUP: flags                              = 0wx00020000
84            val WS_TABSTOP: flags                            = 0wx00010000
85            val WS_MINIMIZEBOX: flags                        = 0wx00020000
86            val WS_MAXIMIZEBOX: flags                        = 0wx00010000
87            val WS_TILED: flags                              = WS_OVERLAPPED
88            val WS_ICONIC: flags                             = WS_MINIMIZE
89            val WS_SIZEBOX: flags                            = WS_THICKFRAME
90            val WS_OVERLAPPEDWINDOW =
91                    flags[WS_OVERLAPPED, WS_CAPTION, WS_SYSMENU,
92                          WS_THICKFRAME, WS_MINIMIZEBOX, WS_MAXIMIZEBOX]
93            val WS_TILEDWINDOW                               = WS_OVERLAPPEDWINDOW
94            val WS_POPUPWINDOW =
95                    flags[WS_POPUP, WS_BORDER, WS_SYSMENU]
96            val WS_CHILDWINDOW                               = WS_CHILD
97    
98            val all = flags[WS_OVERLAPPED, WS_POPUP, WS_CHILD, WS_MINIMIZE, WS_VISIBLE,
99                            WS_DISABLED, WS_CLIPSIBLINGS, WS_CLIPCHILDREN, WS_MAXIMIZE,
100                            WS_CAPTION, WS_BORDER, WS_DLGFRAME, WS_VSCROLL, WS_HSCROLL,
101                            WS_SYSMENU, WS_THICKFRAME, WS_GROUP, WS_TABSTOP, WS_MINIMIZEBOX,
102                            WS_MAXIMIZEBOX]
103    
104            val intersect = List.foldl (fn (a, b) => SysWord.andb(a,b)) all
105        end
106
107        structure ExStyle:>
108        sig
109            include BIT_FLAGS
110            val WS_EX_DLGMODALFRAME: flags and WS_EX_NOPARENTNOTIFY: flags and WS_EX_TOPMOST: flags
111            and WS_EX_ACCEPTFILES : flags and WS_EX_TRANSPARENT: flags and WS_EX_MDICHILD: flags
112            and WS_EX_TOOLWINDOW: flags and WS_EX_WINDOWEDGE: flags and WS_EX_CLIENTEDGE: flags
113            and WS_EX_CONTEXTHELP: flags and WS_EX_RIGHT: flags and WS_EX_LEFT: flags
114            and WS_EX_RTLREADING: flags and WS_EX_LTRREADING: flags and WS_EX_LEFTSCROLLBAR: flags
115            and WS_EX_RIGHTSCROLLBAR: flags and WS_EX_CONTROLPARENT: flags and WS_EX_STATICEDGE: flags
116            and WS_EX_APPWINDOW: flags and WS_EX_OVERLAPPEDWINDOW: flags and WS_EX_PALETTEWINDOW: flags
117        end =
118        struct
119            type flags = SysWord.word
120            fun toWord f = f
121            fun fromWord f = f
122            val flags = List.foldl (fn (a, b) => SysWord.orb(a,b)) 0w0
123            fun allSet (fl1, fl2) = SysWord.andb(fl1, fl2) = fl1
124            fun anySet (fl1, fl2) = SysWord.andb(fl1, fl2) <> 0w0
125            fun clear (fl1, fl2) = SysWord.andb(SysWord.notb fl1, fl2)
126            val WS_EX_DLGMODALFRAME                          = 0wx00000001
127            val WS_EX_NOPARENTNOTIFY                         = 0wx00000004
128            val WS_EX_TOPMOST                                = 0wx00000008
129            val WS_EX_ACCEPTFILES                            = 0wx00000010
130            val WS_EX_TRANSPARENT                            = 0wx00000020
131            val WS_EX_MDICHILD                               = 0wx00000040
132            val WS_EX_TOOLWINDOW                             = 0wx00000080
133            val WS_EX_WINDOWEDGE                             = 0wx00000100
134            val WS_EX_CLIENTEDGE                             = 0wx00000200
135            val WS_EX_CONTEXTHELP                            = 0wx00000400
136        
137            val WS_EX_RIGHT                                  = 0wx00001000
138            val WS_EX_LEFT                                   = 0wx00000000
139            val WS_EX_RTLREADING                             = 0wx00002000
140            val WS_EX_LTRREADING                             = 0wx00000000
141            val WS_EX_LEFTSCROLLBAR                          = 0wx00004000
142            val WS_EX_RIGHTSCROLLBAR                         = 0wx00000000
143        
144            val WS_EX_CONTROLPARENT                          = 0wx00010000
145            val WS_EX_STATICEDGE                             = 0wx00020000
146            val WS_EX_APPWINDOW                              = 0wx00040000
147        
148        
149            val WS_EX_OVERLAPPEDWINDOW = flags[WS_EX_WINDOWEDGE, WS_EX_CLIENTEDGE]
150            val WS_EX_PALETTEWINDOW = flags[WS_EX_WINDOWEDGE, WS_EX_TOOLWINDOW, WS_EX_TOPMOST]
151
152            val all = flags[WS_EX_DLGMODALFRAME, WS_EX_NOPARENTNOTIFY, WS_EX_TOPMOST, WS_EX_ACCEPTFILES,
153                            WS_EX_TRANSPARENT, WS_EX_MDICHILD, WS_EX_TOOLWINDOW, WS_EX_WINDOWEDGE,
154                            WS_EX_CLIENTEDGE, WS_EX_CONTEXTHELP, WS_EX_RIGHT, WS_EX_LEFT, WS_EX_RTLREADING,
155                            WS_EX_LTRREADING, WS_EX_LEFTSCROLLBAR, WS_EX_RIGHTSCROLLBAR, WS_EX_CONTROLPARENT,
156                            WS_EX_STATICEDGE, WS_EX_APPWINDOW]
157    
158            val intersect = List.foldl (fn (a, b) => SysWord.andb(a,b)) all
159        end
160
161        datatype WindowPositionStyle =
162                SWP_ASYNCWINDOWPOS
163            |   SWP_DEFERERASE
164            |   SWP_FRAMECHANGED
165            |   SWP_HIDEWINDOW
166            |   SWP_NOACTIVATE
167            |   SWP_NOCOPYBITS
168            |   SWP_NOMOVE
169            |   SWP_NOOWNERZORDER
170            |   SWP_NOREDRAW
171            |   SWP_NOSENDCHANGING
172            |   SWP_NOSIZE
173            |   SWP_NOZORDER
174            |   SWP_SHOWWINDOW
175            |   SWP_OTHER of Word32.word
176
177        local
178            val tab = [
179            (SWP_NOSIZE,          0wx0001),
180            (SWP_NOMOVE,          0wx0002),
181            (SWP_NOZORDER,        0wx0004),
182            (SWP_NOREDRAW,        0wx0008),
183            (SWP_NOACTIVATE,      0wx0010),
184            (SWP_FRAMECHANGED,    0wx0020),  (* The frame changed: send WM_NCCALCSIZE *)
185            (SWP_SHOWWINDOW,      0wx0040),
186            (SWP_HIDEWINDOW,      0wx0080),
187            (SWP_NOCOPYBITS,      0wx0100),
188            (SWP_NOOWNERZORDER,   0wx0200),  (* Don't do owner Z ordering *)
189            (SWP_NOSENDCHANGING,  0wx0400),  (* Don't send WM_WINDOWPOSCHANGING *)
190            (SWP_DEFERERASE,      0wx2000),
191            (SWP_ASYNCWINDOWPOS,  0wx4000)]
192
193            (* It seems that some other bits are set although they're not defined. *)
194            fun toWord (SWP_OTHER i) = i | toWord _ = raise Match
195        in
196            val cWINDOWPOSITIONSTYLE = tableSetConversion(tab, SOME(SWP_OTHER, toWord))
197        end
198        
199        (* In C the parent and menu arguments are combined in a rather odd way. *)
200        datatype ParentType =
201            PopupWithClassMenu      (* Popup or overlapped window using class menu. *)
202        |   PopupWindow of HMENU    (* Popup or overlapped window with supplied menu. *)
203        |   ChildWindow of { parent: HWND, id: int } (* Child window. *)
204
205        (* This function is used whenever windows are created. *)
206        local
207            open Style
208        in
209            (* In the case of a child window the "menu" is actually an integer
210               which identifies the child in notification messages to the parent.
211               We silently set or clear the WS_CHILD bit depending on the argument. *)
212            fun unpackWindowRelation(relation: ParentType, style) =
213                case relation of
214                    PopupWithClassMenu =>
215                        (hwndNull, Memory.null, toWord(clear(WS_CHILD, style)))
216                |   PopupWindow hm =>
217                        (hwndNull, voidStarOfHandle hm, toWord(clear(WS_CHILD, style)))
218                |   ChildWindow{parent, id} =>
219                        (parent, Memory.sysWord2VoidStar(SysWord.fromInt id), toWord(flags[WS_CHILD, style]))
220        end
221    
222    end
223end;
224