|
|
1.1 root 1: % Copyright Barbara Liskov 1985
2:
3: x_input = cluster is init, set_squish,
4: enq, deq, edeq, mdeq, wdeq,
5: pending, epending, mpending, wpending,
6: empty_event
7:
8: elist = array[event]
9: i2w = _cvt[int, x_window]
10:
11: rep = null
12:
13: own have: bool := false
14: own free: elist
15: own queue: elist
16: own squish: bool
17:
18: init = proc ()
19: free := elist$new()
20: queue := elist$new()
21: squish := true
22: have := true
23: end init
24:
25: set_squish = proc (flag: bool)
26: squish := flag
27: end set_squish
28:
29: enq = proc (e: event)
30: if squish cand e.kind = MouseMoved
31: then ne: event := elist$top(queue)
32: if ne.kind = MouseMoved cand w2i(ne.win) = w2i(e.win)
33: then event$r_gets_r(ne, e)
34: return
35: end
36: end except when bounds: end
37: ne: event := empty_event()
38: event$r_gets_r(ne, e)
39: elist$addh(queue, ne)
40: end enq
41:
42: deq = proc (e: event)
43: while elist$empty(queue) do
44: x_buf$events(true)
45: end
46: oe: event := elist$reml(queue)
47: event$r_gets_r(e, oe)
48: elist$addh(free, oe)
49: end deq
50:
51: edeq = proc (kind: int, e: event)
52: while true do
53: for i: int in elist$indexes(queue) do
54: oe: event := queue[i]
55: if oe.kind = kind
56: then event$r_gets_r(e, oe)
57: elist$addh(free, oe)
58: while true do
59: queue[i] := queue[i + 1]
60: i := i + 1
61: end except when bounds: end
62: elist$remh(queue)
63: return
64: end
65: end
66: x_buf$events(true)
67: end
68: end edeq
69:
70: mdeq = proc (kinds: int, e: event)
71: while true do
72: for i: int in elist$indexes(queue) do
73: oe: event := queue[i]
74: if i_and(oe.kind, kinds) ~= 0
75: then event$r_gets_r(e, oe)
76: elist$addh(free, oe)
77: while true do
78: queue[i] := queue[i + 1]
79: i := i + 1
80: end except when bounds: end
81: elist$remh(queue)
82: return
83: end
84: end
85: x_buf$events(true)
86: end
87: end mdeq
88:
89: wdeq = proc (w: x_window, kinds: int, e: event)
90: while true do
91: for i: int in elist$indexes(queue) do
92: oe: event := queue[i]
93: if w2i(oe.win) = w2i(w) cand i_and(oe.kind, kinds) ~= 0
94: then event$r_gets_r(e, oe)
95: elist$addh(free, oe)
96: while true do
97: queue[i] := queue[i + 1]
98: i := i + 1
99: end except when bounds: end
100: elist$remh(queue)
101: return
102: end
103: end
104: x_buf$events(true)
105: end
106: end wdeq
107:
108: pending = proc () returns (bool)
109: if ~elist$empty(queue)
110: then return(true) end
111: x_buf$events(false)
112: return(~elist$empty(queue))
113: end pending
114:
115: epending = proc (kind: int) returns (bool)
116: for e: event in elist$elements(queue) do
117: if e.kind = kind
118: then return(true) end
119: end
120: i: int := elist$high(queue)
121: x_buf$events(false)
122: while true do
123: i := i + 1
124: if queue[i].kind = kind
125: then return(true) end
126: end except when bounds: end
127: return(false)
128: end epending
129:
130: mpending = proc (kinds: int) returns (bool)
131: for e: event in elist$elements(queue) do
132: if i_and(e.kind, kinds) ~= 0
133: then return(true) end
134: end
135: i: int := elist$high(queue)
136: x_buf$events(false)
137: while true do
138: i := i + 1
139: if i_and(queue[i].kind, kinds) ~= 0
140: then return(true) end
141: end except when bounds: end
142: return(false)
143: end mpending
144:
145: wpending = proc (w: x_window, kinds: int) returns (bool)
146: for e: event in elist$elements(queue) do
147: if w2i(e.win) = w2i(w) cand i_and(e.kind, kinds) ~= 0
148: then return(true) end
149: end
150: i: int := elist$high(queue)
151: x_buf$events(false)
152: while true do
153: i := i + 1
154: e: event := queue[i]
155: if w2i(e.win) = w2i(w) cand i_and(e.kind, kinds) ~= 0
156: then return(true) end
157: end except when bounds: end
158: return(false)
159: end wpending
160:
161: empty_event = proc () returns (event)
162: if have
163: then return(elist$remh(free))
164: end except when bounds: end
165: return(event${kind: 0,
166: value: 0,
167: mask: 0,
168: win: i2w(0),
169: sub: i2w(0),
170: x: 0,
171: y: 0,
172: x0: 0,
173: y0: 0,
174: time: 0})
175: end empty_event
176:
177: end x_input
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.