Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/eXene/lib/protocol/keybut.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/lib/protocol/keybut.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* keybut.sml
2 :     *
3 :     * COPYRIGHT (c) 1990,1991 by John H. Reppy. See COPYRIGHT file for details.
4 :     *
5 :     * Support for modifier key sets and mouse button sets. The modifier key value
6 :     * AnyModifier is the power-set of modifier keys.
7 :     *)
8 :    
9 :     signature KEY_BUT =
10 :     sig
11 :    
12 :     (* modifier buttons *)
13 :     datatype modkey
14 :     = ShiftKey | LockKey | ControlKey
15 :     | Mod1Key | Mod2Key | Mod3Key | Mod4Key | Mod5Key
16 :     | AnyModifier
17 :     (* mouse buttons *)
18 :     datatype mbutton = MButton of int
19 :    
20 :     (* modifier key states *)
21 :     eqtype modkey_state
22 :    
23 :     val mkModState : modkey list -> modkey_state
24 :    
25 :     val unionMod : (modkey_state * modkey_state) -> modkey_state
26 :     val intersectMod : (modkey_state * modkey_state) -> modkey_state
27 :     (* matchMod(a, b) returns true, if a=b or if b=AnyModifier. *)
28 :     val matchMod : (modkey_state * modkey_state) -> bool
29 :     val emptyMod : modkey_state -> bool
30 :    
31 :     val shiftIsSet : modkey_state -> bool
32 :     val lockIsSet : modkey_state -> bool
33 :     val cntrlIsSet : modkey_state -> bool
34 :     val modIsSet : (modkey_state * int) -> bool
35 :    
36 :     (* Mouse button states *)
37 :     eqtype mbutton_state
38 :    
39 :     val mkButState : mbutton list -> mbutton_state
40 :    
41 :     val unionMBut : (mbutton_state * mbutton_state) -> mbutton_state
42 :     val intersectMBut : (mbutton_state * mbutton_state) -> mbutton_state
43 :    
44 :     val invertMBut : (mbutton_state * mbutton) -> mbutton_state
45 :    
46 :     val mbutAllClr : mbutton_state -> bool
47 :     val mbutSomeSet : mbutton_state -> bool
48 :     val mbut1IsSet : mbutton_state -> bool
49 :     val mbut2IsSet : mbutton_state -> bool
50 :     val mbut3IsSet : mbutton_state -> bool
51 :     val mbut4IsSet : mbutton_state -> bool
52 :     val mbut5IsSet : mbutton_state -> bool
53 :     val mbutIsSet : (mbutton_state * mbutton) -> bool
54 :    
55 :     end (* KEY_BUT *)
56 :    
57 :     structure KeyBut : KEY_BUT =
58 :     struct
59 :     open XProtTypes
60 :    
61 :     val & = Word.andb and ++ = Word.orb
62 :     val << = Word.<<
63 :     infix & ++ <<
64 :    
65 :     (** Modifier key states **)
66 :    
67 :     val shiftMask = 0wx0001
68 :     val lockMask = 0wx0002
69 :     val cntlMask = 0wx0004
70 :     val mod1Mask = 0wx0008
71 :     val mod2Mask = 0wx0010
72 :     val mod3Mask = 0wx0020
73 :     val mod4Mask = 0wx0040
74 :     val mod5Mask = 0wx0080
75 :    
76 :     fun unionMod (MKState m1, MKState m2) = MKState(m1 ++ m2)
77 :     | unionMod _ = AnyModKey
78 :     fun intersectMod (MKState m1, MKState m2) = MKState(m1 & m2)
79 :     | intersectMod (AnyModKey, m) = m
80 :     | intersectMod (m, AnyModKey) = m
81 :     fun matchMod (MKState m1, MKState m2) = (m1 = m2)
82 :     | matchMod (_, AnyModKey) = true
83 :     | matchMod _ = false
84 :     fun emptyMod AnyModKey = true
85 :     | emptyMod (MKState 0w0) = true
86 :     | emptyMod _ = false
87 :    
88 :     fun mkModState l = let
89 :     exception Any
90 :     fun f ([], m) = MKState m
91 :     | f (k::r, m) = let
92 :     val mask = (case k
93 :     of AnyModifier => raise Any
94 :     | ShiftKey => shiftMask
95 :     | LockKey => lockMask
96 :     | ControlKey => cntlMask
97 :     | Mod1Key => mod1Mask
98 :     | Mod2Key => mod2Mask
99 :     | Mod3Key => mod3Mask
100 :     | Mod4Key => mod4Mask
101 :     | Mod5Key => mod5Mask)
102 :     in
103 :     f (r, m ++ mask)
104 :     end
105 :     in
106 :     (f (l, 0w0)) handle Any => AnyModKey
107 :     end
108 :    
109 :     fun shiftIsSet AnyModKey = true
110 :     | shiftIsSet (MKState s) = ((s & shiftMask) <> 0w0)
111 :     fun lockIsSet AnyModKey = true
112 :     | lockIsSet (MKState s) = ((s & lockMask) <> 0w0)
113 :     fun cntrlIsSet AnyModKey = true
114 :     | cntrlIsSet (MKState s) = ((s & cntlMask) <> 0w0)
115 :     fun modIsSet (AnyModKey, _) = true
116 :     | modIsSet (MKState s, i) = ((s & (mod1Mask << Word.fromInt(i-1))) <> 0w0)
117 :    
118 :    
119 :     (** Mouse button states **)
120 :    
121 :     val but1Mask = 0wx0100
122 :     val but2Mask = 0wx0200
123 :     val but3Mask = 0wx0400
124 :     val but4Mask = 0wx0800
125 :     val but5Mask = 0wx1000
126 :     val allButMask = 0wx1f00
127 :    
128 :     fun unionMBut (MBState m1, MBState m2) = MBState(m1 ++ m2)
129 :     fun intersectMBut (MBState m1, MBState m2) = MBState(m1 & m2)
130 :    
131 :     fun invertMBut (MBState s, MButton b) =
132 :     MBState(Word.xorb(s, but1Mask << (Word.fromInt(b-1))))
133 :    
134 :     fun mkButState l = let
135 :     fun f ([], m) = MBState m
136 :     | f ((MButton i)::r, m) = f (r, m ++ (but1Mask << Word.fromInt(i-1)))
137 :     in
138 :     f(l, 0w0)
139 :     end
140 :    
141 :     fun mbutAllClr (MBState s) = ((s & allButMask) = 0w0)
142 :     fun mbutSomeSet (MBState s) = ((s & allButMask) <> 0w0)
143 :     fun mbut1IsSet (MBState s) = ((s & but1Mask) <> 0w0)
144 :     fun mbut2IsSet (MBState s) = ((s & but2Mask) <> 0w0)
145 :     fun mbut3IsSet (MBState s) = ((s & but3Mask) <> 0w0)
146 :     fun mbut4IsSet (MBState s) = ((s & but4Mask) <> 0w0)
147 :     fun mbut5IsSet (MBState s) = ((s & but5Mask) <> 0w0)
148 :     fun mbutIsSet (MBState s, MButton i) =
149 :     ((s & (but1Mask << Word.fromInt(i-1))) <> 0w0)
150 :    
151 :     end (* KeyBut *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0