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(* Static windows e.g. labels. *) 21structure Static: 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 SS_LEFT: flags and SS_CENTER: flags and SS_RIGHT: flags and SS_ICON: flags 35 and SS_BLACKRECT: flags and SS_GRAYRECT: flags and SS_WHITERECT: flags 36 and SS_BLACKFRAME: flags and SS_GRAYFRAME: flags and SS_WHITEFRAME: flags 37 and SS_USERITEM: flags and SS_SIMPLE: flags and SS_LEFTNOWORDWRAP: flags 38 and SS_OWNERDRAW: flags and SS_BITMAP: flags and SS_ENHMETAFILE: flags 39 and SS_ETCHEDHORZ: flags and SS_ETCHEDVERT: flags and SS_ETCHEDFRAME: flags 40 and SS_TYPEMASK: flags and SS_NOPREFIX: flags and SS_NOTIFY: flags and SS_CENTERIMAGE: flags 41 and SS_RIGHTJUST: flags and SS_REALSIZEIMAGE: flags and SS_SUNKEN: flags 42 and SS_ENDELLIPSIS: flags and SS_PATHELLIPSIS: flags and SS_WORDELLIPSIS: flags 43 and SS_ELLIPSISMASK: flags 44 end 45 46 structure Notifications: 47 sig 48 val STN_CLICKED: int 49 val STN_DBLCLK: int 50 val STN_ENABLE: int 51 val STN_DISABLE: int 52 end 53end 54= 55struct 56 structure Style = 57 struct 58 open Window.Style (* Include all the windows styles. *) 59 60 val SS_LEFT: flags = fromWord 0wx00000000 61 val SS_CENTER: flags = fromWord 0wx00000001 62 val SS_RIGHT: flags = fromWord 0wx00000002 63 val SS_ICON: flags = fromWord 0wx00000003 64 val SS_BLACKRECT: flags = fromWord 0wx00000004 65 val SS_GRAYRECT: flags = fromWord 0wx00000005 66 val SS_WHITERECT: flags = fromWord 0wx00000006 67 val SS_BLACKFRAME: flags = fromWord 0wx00000007 68 val SS_GRAYFRAME: flags = fromWord 0wx00000008 69 val SS_WHITEFRAME: flags = fromWord 0wx00000009 70 val SS_USERITEM: flags = fromWord 0wx0000000A 71 val SS_SIMPLE: flags = fromWord 0wx0000000B 72 val SS_LEFTNOWORDWRAP: flags = fromWord 0wx0000000C 73 val SS_OWNERDRAW: flags = fromWord 0wx0000000D 74 val SS_BITMAP: flags = fromWord 0wx0000000E 75 val SS_ENHMETAFILE: flags = fromWord 0wx0000000F 76 val SS_ETCHEDHORZ: flags = fromWord 0wx00000010 77 val SS_ETCHEDVERT: flags = fromWord 0wx00000011 78 val SS_ETCHEDFRAME: flags = fromWord 0wx00000012 79 val SS_TYPEMASK: flags = fromWord 0wx0000001F 80 val SS_NOPREFIX: flags = fromWord 0wx00000080 81 val SS_NOTIFY: flags = fromWord 0wx00000100 82 val SS_CENTERIMAGE: flags = fromWord 0wx00000200 83 val SS_RIGHTJUST: flags = fromWord 0wx00000400 84 val SS_REALSIZEIMAGE: flags = fromWord 0wx00000800 85 val SS_SUNKEN: flags = fromWord 0wx00001000 86 val SS_ENDELLIPSIS: flags = fromWord 0wx00004000 87 val SS_PATHELLIPSIS: flags = fromWord 0wx00008000 88 val SS_WORDELLIPSIS: flags = fromWord 0wx0000C000 89 val SS_ELLIPSISMASK: flags = fromWord 0wx0000C000 90 91 val all = flags[Window.Style.all, SS_LEFT, SS_CENTER, SS_RIGHT, SS_ICON, SS_BLACKRECT, 92 SS_GRAYRECT, SS_WHITERECT, SS_BLACKFRAME, SS_GRAYFRAME, 93 SS_WHITEFRAME, SS_USERITEM, SS_SIMPLE, SS_LEFTNOWORDWRAP, 94 SS_OWNERDRAW, SS_BITMAP, SS_ENHMETAFILE, SS_ETCHEDHORZ, 95 SS_ETCHEDVERT, SS_ETCHEDFRAME, SS_TYPEMASK, SS_NOPREFIX, 96 SS_NOTIFY, SS_CENTERIMAGE, SS_RIGHTJUST, SS_REALSIZEIMAGE, 97 SS_SUNKEN, SS_ENDELLIPSIS, SS_PATHELLIPSIS, SS_WORDELLIPSIS, 98 SS_ELLIPSISMASK] 99 val intersect = 100 List.foldl (fn (a, b) => fromWord(SysWord.andb(toWord a, toWord b))) all 101 end 102 103 structure Notifications = 104 struct 105 val STN_CLICKED = 0 106 val STN_DBLCLK = 1 107 val STN_ENABLE = 2 108 val STN_DISABLE = 3 109 end 110end; 111 112(* 113let 114 open Static.Style 115 116 fun getType w = 117 let 118 val typeField = fromWord(SysWord.andb(toWord w, toWord SS_TYPEMASK)) 119 in 120 if typeField = SS_LEFT then "SS_LEFT" 121 else if typeField = SS_CENTER then "SS_CENTER" 122 else if typeField = SS_RIGHT then "SS_RIGHT" 123 else if typeField = SS_ICON then "SS_ICON" 124 else if typeField = SS_BLACKRECT then "SS_BLACKRECT" 125 else if typeField = SS_GRAYRECT then "SS_GRAYRECT" 126 else if typeField = SS_WHITERECT then "SS_WHITERECT" 127 else if typeField = SS_BLACKFRAME then "SS_BLACKFRAME" 128 else if typeField = SS_GRAYFRAME then "SS_GRAYFRAME" 129 else if typeField = SS_WHITEFRAME then "SS_WHITEFRAME" 130 else if typeField = SS_USERITEM then "SS_USERITEM" 131 else if typeField = SS_SIMPLE then "SS_SIMPLE" 132 else if typeField = SS_LEFTNOWORDWRAP then "SS_LEFTNOWORDWRAP" 133 else if typeField = SS_OWNERDRAW then "SS_OWNERDRAW" 134 else if typeField = SS_BITMAP then "SS_BITMAP" 135 else if typeField = SS_ENHMETAFILE then "SS_ENHMETAFILE" 136 else if typeField = SS_ETCHEDHORZ then "SS_ETCHEDHORZ" 137 else if typeField = SS_ETCHEDVERT then "SS_ETCHEDVERT" 138 else if typeField = SS_ETCHEDFRAME then "SS_ETCHEDFRAME" 139 else "??" 140 end 141 142 val flagTable = 143 [(SS_NOPREFIX, "SS_NOPREFIX"), 144 (SS_NOTIFY, "SS_NOTIFY"), 145 (SS_CENTERIMAGE, "SS_CENTERIMAGE"), 146 (SS_RIGHTJUST, "SS_RIGHTJUST"), 147 (SS_REALSIZEIMAGE, "SS_REALSIZEIMAGE"), 148 (SS_SUNKEN, "SS_SUNKEN"), 149 (SS_WORDELLIPSIS, "SS_WORDELLIPSIS"), (* Must come before the next two. *) 150 (SS_ENDELLIPSIS, "SS_ENDELLIPSIS"), 151 (SS_PATHELLIPSIS, "SS_PATHELLIPSIS"), 152 (WS_POPUP, "WS_POPUP"), 153 (WS_CHILD, "WS_CHILD"), 154 (WS_MINIMIZE, "WS_MINIMIZE"), 155 (WS_VISIBLE, "WS_VISIBLE"), 156 (WS_DISABLED, "WS_DISABLED"), 157 (WS_CLIPSIBLINGS, "WS_CLIPSIBLINGS"), 158 (WS_CLIPCHILDREN, "WS_CLIPCHILDREN"), 159 (WS_MAXIMIZE, "WS_MAXIMIZE"), 160 (WS_CAPTION, "WS_CAPTION"), 161 (WS_BORDER, "WS_BORDER"), 162 (WS_DLGFRAME, "WS_DLGFRAME"), 163 (WS_VSCROLL, "WS_VSCROLL"), 164 (WS_HSCROLL, "WS_HSCROLL"), 165 (WS_SYSMENU, "WS_SYSMENU"), 166 (WS_THICKFRAME, "WS_THICKFRAME"), 167 (WS_GROUP, "WS_GROUP"), 168 (WS_TABSTOP, "WS_TABSTOP"), 169 (WS_MINIMIZEBOX, "WS_MINIMIZEBOX"), 170 (WS_MAXIMIZEBOX, "WS_MAXIMIZEBOX")] 171 172 fun accumulateFlags f [] = [] 173 | accumulateFlags f ((w, s)::t) = 174 if allSet(w, f) then s :: accumulateFlags(clear(w, f)) t 175 else accumulateFlags f t 176 177 fun printFlags(put, beg, brk, nd) depth _ x = 178 (* This is just the code to print a list. *) 179 let 180 181 val stringFlags = getType x :: accumulateFlags x flagTable 182 fun plist [] depth = () 183 | plist _ 0 = put "..." 184 | plist [h] depth = put h 185 | plist (h::t) depth = 186 ( put (h^","); 187 brk (1, 0); 188 plist t (depth - 1) 189 ) 190 in 191 beg (3, false); 192 put "["; 193 if depth <= 0 then put "..." else plist stringFlags depth; 194 put "]"; 195 nd () 196 end 197in 198 PolyML.install_pp printFlags 199end; 200*)