1(*
2    Copyright (c) 2001
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 as published by the Free Software Foundation; either
8    version 2.1 of the License, or (at your option) any later version.
9
10    This library is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    Lesser General Public License for more details.
14
15    You should have received a copy of the GNU Lesser General Public
16    License along with this library; if not, write to the Free Software
17    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
18*)
19
20(* Buttons. *)
21structure Button:
22sig
23    structure Style:
24    sig
25        include BIT_FLAGS where type flags = Window.Style.flags
26        val WS_OVERLAPPED: flags and WS_POPUP: flags and WS_CHILD: flags and WS_MINIMIZE: flags
27        and WS_VISIBLE: flags and WS_DISABLED:flags and WS_CLIPSIBLINGS:flags
28        and WS_CLIPCHILDREN:flags and WS_MAXIMIZE:flags and WS_CAPTION:flags
29        and WS_BORDER:flags and WS_DLGFRAME:flags and WS_VSCROLL:flags and WS_HSCROLL:flags
30        and WS_SYSMENU:flags and WS_THICKFRAME:flags and WS_GROUP:flags and WS_TABSTOP:flags
31        and WS_MINIMIZEBOX:flags and WS_MAXIMIZEBOX:flags and WS_TILED:flags and WS_ICONIC:flags
32        and WS_SIZEBOX:flags and WS_OVERLAPPEDWINDOW:flags and WS_TILEDWINDOW:flags
33        and WS_POPUPWINDOW:flags and WS_CHILDWINDOW:flags
34        and BS_3STATE: flags and BS_AUTO3STATE: flags and BS_AUTOCHECKBOX: flags
35        and BS_AUTORADIOBUTTON: flags and BS_BITMAP: flags and BS_BOTTOM: flags
36        and BS_CENTER: flags and BS_CHECKBOX: flags and BS_DEFPUSHBUTTON: flags
37        and BS_FLAT: flags and BS_GROUPBOX: flags and BS_ICON: flags and BS_LEFT: flags
38        and BS_LEFTTEXT: flags and BS_MULTILINE: flags and BS_NOTIFY: flags
39        and BS_OWNERDRAW: flags and BS_PUSHBUTTON: flags and BS_PUSHLIKE: flags
40        and BS_RADIOBUTTON: flags and BS_RIGHT: flags and BS_RIGHTBUTTON: flags
41        and BS_TEXT: flags and BS_TOP: flags and BS_USERBUTTON: flags and BS_VCENTER: flags
42    end
43
44    structure Notifications:
45    sig
46        val BN_CLICKED: int
47        val BN_PAINT: int
48        val BN_HILITE: int
49        val BN_UNHILITE: int
50        val BN_DISABLE: int
51        val BN_DOUBLECLICKED: int
52        val BN_PUSHED: int
53        val BN_UNPUSHED: int
54        val BN_DBLCLK: int
55        val BN_SETFOCUS: int
56        val BN_KILLFOCUS: int
57    end
58
59    structure State:
60    sig
61        val BST_UNCHECKED: int
62        val BST_CHECKED: int
63        val BST_INDETERMINATE: int
64        val BST_PUSHED: int
65        val BST_FOCUS: int
66    end
67
68end
69=
70struct
71    structure Style =
72    struct
73        open Window.Style (* Include all the windows styles. *)
74        type flags = Window.Style.flags (* Causes the type to print as Dialog.Style.flags. *)
75
76        val BS_PUSHBUTTON: flags       = fromWord 0wx00000000
77        val BS_DEFPUSHBUTTON: flags    = fromWord 0wx00000001
78        val BS_CHECKBOX: flags         = fromWord 0wx00000002
79        val BS_AUTOCHECKBOX: flags     = fromWord 0wx00000003
80        val BS_RADIOBUTTON: flags      = fromWord 0wx00000004
81        val BS_3STATE: flags           = fromWord 0wx00000005
82        val BS_AUTO3STATE: flags       = fromWord 0wx00000006
83        val BS_GROUPBOX: flags         = fromWord 0wx00000007
84        val BS_USERBUTTON: flags       = fromWord 0wx00000008
85        val BS_AUTORADIOBUTTON: flags  = fromWord 0wx00000009
86        val BS_OWNERDRAW: flags        = fromWord 0wx0000000B
87        val BS_LEFTTEXT: flags         = fromWord 0wx00000020
88        val BS_TEXT: flags             = fromWord 0wx00000000
89        val BS_ICON: flags             = fromWord 0wx00000040
90        val BS_BITMAP: flags           = fromWord 0wx00000080
91        val BS_LEFT: flags             = fromWord 0wx00000100
92        val BS_RIGHT: flags            = fromWord 0wx00000200
93        val BS_CENTER: flags           = fromWord 0wx00000300
94        val BS_TOP: flags              = fromWord 0wx00000400
95        val BS_BOTTOM: flags           = fromWord 0wx00000800
96        val BS_VCENTER: flags          = fromWord 0wx00000C00
97        val BS_PUSHLIKE: flags         = fromWord 0wx00001000
98        val BS_MULTILINE: flags        = fromWord 0wx00002000
99        val BS_NOTIFY: flags           = fromWord 0wx00004000
100        val BS_FLAT: flags             = fromWord 0wx00008000
101        val BS_RIGHTBUTTON: flags      = BS_LEFTTEXT
102
103        val all = flags[Window.Style.all, BS_PUSHBUTTON, BS_DEFPUSHBUTTON, BS_CHECKBOX,
104                        BS_AUTOCHECKBOX, BS_RADIOBUTTON, BS_3STATE, BS_AUTO3STATE, BS_GROUPBOX,
105                        BS_USERBUTTON, BS_AUTORADIOBUTTON, BS_OWNERDRAW, BS_LEFTTEXT, BS_TEXT,
106                        BS_ICON, BS_BITMAP, BS_LEFT, BS_RIGHT, BS_CENTER, BS_TOP, BS_BOTTOM,
107                        BS_VCENTER, BS_PUSHLIKE, BS_MULTILINE, BS_NOTIFY, BS_FLAT]
108
109        val intersect =
110            List.foldl (fn (a, b) => fromWord(SysWord.andb(toWord a, toWord b))) all
111    end
112
113    structure Notifications =
114    struct
115        val BN_CLICKED          = 0
116        val BN_PAINT            = 1
117        val BN_HILITE           = 2
118        val BN_UNHILITE         = 3
119        val BN_DISABLE          = 4
120        val BN_DOUBLECLICKED    = 5
121        val BN_PUSHED           = BN_HILITE
122        val BN_UNPUSHED         = BN_UNHILITE
123        val BN_DBLCLK           = BN_DOUBLECLICKED
124        val BN_SETFOCUS         = 6
125        val BN_KILLFOCUS        = 7
126    end
127
128    (* These are returned by SendMessage(button, BM_GETCHECK) so need to be integers. *)
129    structure State =
130    struct
131        val BST_UNCHECKED      = 0x0000
132        val BST_CHECKED        = 0x0001
133        val BST_INDETERMINATE  = 0x0002
134        val BST_PUSHED         = 0x0004
135        val BST_FOCUS          = 0x0008
136    end
137
138end;
139
140(*
141let
142    open Button.Style
143
144    fun getType w =
145    let
146        val typeField = fromWord(SysWord.andb(toWord w, 0wx0f))
147    in
148        if typeField = BS_PUSHBUTTON then "BS_PUSHBUTTON"
149        else if typeField = BS_DEFPUSHBUTTON then "BS_DEFPUSHBUTTON"
150        else if typeField = BS_CHECKBOX then "BS_CHECKBOX"
151        else if typeField = BS_AUTOCHECKBOX then "BS_AUTOCHECKBOX"
152        else if typeField = BS_RADIOBUTTON then "BS_RADIOBUTTON"
153        else if typeField = BS_3STATE then "BS_3STATE"
154        else if typeField = BS_AUTO3STATE then "BS_AUTO3STATE"
155        else if typeField = BS_GROUPBOX then "BS_GROUPBOX"
156        else if typeField = BS_USERBUTTON then "BS_USERBUTTON"
157        else if typeField = BS_AUTORADIOBUTTON then "BS_AUTORADIOBUTTON"
158        else if typeField = BS_OWNERDRAW then "BS_OWNERDRAW"
159        else "??"
160    end
161
162    val flagTable =
163        [(BS_LEFTTEXT,          "BS_LEFTTEXT"),
164         (BS_ICON,              "BS_ICON"),
165         (BS_BITMAP,            "BS_BITMAP"),
166         (BS_CENTER,            "BS_CENTER"), (* Must come before the next two. *)
167         (BS_LEFT,              "BS_LEFT"),
168         (BS_RIGHT,             "BS_RIGHT"),
169         (BS_VCENTER,           "BS_VCENTER"), (* Must come before the next two. *)
170         (BS_TOP,               "BS_TOP"),
171         (BS_BOTTOM,            "BS_BOTTOM"),
172         (BS_PUSHLIKE,          "BS_PUSHLIKE"),
173         (BS_MULTILINE,         "BS_MULTILINE"),
174         (BS_NOTIFY,            "BS_NOTIFY"),
175         (BS_FLAT,              "BS_FLAT"),
176         (WS_POPUP,             "WS_POPUP"),
177         (WS_CHILD,             "WS_CHILD"),
178         (WS_MINIMIZE,          "WS_MINIMIZE"),
179         (WS_VISIBLE,           "WS_VISIBLE"),
180         (WS_DISABLED,          "WS_DISABLED"),
181         (WS_CLIPSIBLINGS,      "WS_CLIPSIBLINGS"),
182         (WS_CLIPCHILDREN,      "WS_CLIPCHILDREN"),
183         (WS_MAXIMIZE,          "WS_MAXIMIZE"),
184         (WS_CAPTION,           "WS_CAPTION"),
185         (WS_BORDER,            "WS_BORDER"),
186         (WS_DLGFRAME,          "WS_DLGFRAME"),
187         (WS_VSCROLL,           "WS_VSCROLL"),
188         (WS_HSCROLL,           "WS_HSCROLL"),
189         (WS_SYSMENU,           "WS_SYSMENU"),
190         (WS_THICKFRAME,        "WS_THICKFRAME"),
191         (WS_GROUP,             "WS_GROUP"),
192         (WS_TABSTOP,           "WS_TABSTOP"),
193         (WS_MINIMIZEBOX,       "WS_MINIMIZEBOX"),
194         (WS_MAXIMIZEBOX,       "WS_MAXIMIZEBOX")]
195
196    fun accumulateFlags f [] = []
197     |  accumulateFlags f ((w, s)::t) =
198        if allSet(w, f) then s :: accumulateFlags(clear(w, f)) t
199        else accumulateFlags f t
200
201    fun printFlags(put, beg, brk, nd) depth _ x =
202        (* This is just the code to print a list. *)
203        let
204
205          val stringFlags = getType x :: accumulateFlags x flagTable
206          fun plist [] depth = ()
207           |  plist _ 0 = put "..."
208           |  plist [h]    depth = put h
209           |  plist (h::t) depth =
210                  ( put (h^",");
211                    brk (1, 0);
212                    plist t (depth - 1)
213                  )
214        in
215          beg (3, false);
216          put "[";
217          if depth <= 0 then put "..." else plist stringFlags depth;
218          put "]";
219          nd ()
220        end
221in
222    PolyML.install_pp printFlags
223end;
224*)