+% Copyright Barbara Liskov 1985
+
+x_input = cluster is init, set_squish,
+ enq, deq, edeq, mdeq, wdeq,
+ pending, epending, mpending, wpending,
+ empty_event
+
+elist = array[event]
+i2w = _cvt[int, x_window]
+
+rep = null
+
+own have: bool := false
+own free: elist
+own queue: elist
+own squish: bool
+
+init = proc ()
+ free := elist$new()
+ queue := elist$new()
+ squish := true
+ have := true
+ end init
+
+set_squish = proc (flag: bool)
+ squish := flag
+ end set_squish
+
+enq = proc (e: event)
+ if squish cand e.kind = MouseMoved
+ then ne: event := elist$top(queue)
+ if ne.kind = MouseMoved cand w2i(ne.win) = w2i(e.win)
+ then event$r_gets_r(ne, e)
+ return
+ end
+ end except when bounds: end
+ ne: event := empty_event()
+ event$r_gets_r(ne, e)
+ elist$addh(queue, ne)
+ end enq
+
+deq = proc (e: event)
+ while elist$empty(queue) do
+ x_buf$events(true)
+ end
+ oe: event := elist$reml(queue)
+ event$r_gets_r(e, oe)
+ elist$addh(free, oe)
+ end deq
+
+edeq = proc (kind: int, e: event)
+ while true do
+ for i: int in elist$indexes(queue) do
+ oe: event := queue[i]
+ if oe.kind = kind
+ then event$r_gets_r(e, oe)
+ elist$addh(free, oe)
+ while true do
+ queue[i] := queue[i + 1]
+ i := i + 1
+ end except when bounds: end
+ elist$remh(queue)
+ return
+ end
+ end
+ x_buf$events(true)
+ end
+ end edeq
+
+mdeq = proc (kinds: int, e: event)
+ while true do
+ for i: int in elist$indexes(queue) do
+ oe: event := queue[i]
+ if i_and(oe.kind, kinds) ~= 0
+ then event$r_gets_r(e, oe)
+ elist$addh(free, oe)
+ while true do
+ queue[i] := queue[i + 1]
+ i := i + 1
+ end except when bounds: end
+ elist$remh(queue)
+ return
+ end
+ end
+ x_buf$events(true)
+ end
+ end mdeq
+
+wdeq = proc (w: x_window, kinds: int, e: event)
+ while true do
+ for i: int in elist$indexes(queue) do
+ oe: event := queue[i]
+ if w2i(oe.win) = w2i(w) cand i_and(oe.kind, kinds) ~= 0
+ then event$r_gets_r(e, oe)
+ elist$addh(free, oe)
+ while true do
+ queue[i] := queue[i + 1]
+ i := i + 1
+ end except when bounds: end
+ elist$remh(queue)
+ return
+ end
+ end
+ x_buf$events(true)
+ end
+ end wdeq
+
+pending = proc () returns (bool)
+ if ~elist$empty(queue)
+ then return(true) end
+ x_buf$events(false)
+ return(~elist$empty(queue))
+ end pending
+
+epending = proc (kind: int) returns (bool)
+ for e: event in elist$elements(queue) do
+ if e.kind = kind
+ then return(true) end
+ end
+ i: int := elist$high(queue)
+ x_buf$events(false)
+ while true do
+ i := i + 1
+ if queue[i].kind = kind
+ then return(true) end
+ end except when bounds: end
+ return(false)
+ end epending
+
+mpending = proc (kinds: int) returns (bool)
+ for e: event in elist$elements(queue) do
+ if i_and(e.kind, kinds) ~= 0
+ then return(true) end
+ end
+ i: int := elist$high(queue)
+ x_buf$events(false)
+ while true do
+ i := i + 1
+ if i_and(queue[i].kind, kinds) ~= 0
+ then return(true) end
+ end except when bounds: end
+ return(false)
+ end mpending
+
+wpending = proc (w: x_window, kinds: int) returns (bool)
+ for e: event in elist$elements(queue) do
+ if w2i(e.win) = w2i(w) cand i_and(e.kind, kinds) ~= 0
+ then return(true) end
+ end
+ i: int := elist$high(queue)
+ x_buf$events(false)
+ while true do
+ i := i + 1
+ e: event := queue[i]
+ if w2i(e.win) = w2i(w) cand i_and(e.kind, kinds) ~= 0
+ then return(true) end
+ end except when bounds: end
+ return(false)
+ end wpending
+
+empty_event = proc () returns (event)
+ if have
+ then return(elist$remh(free))
+ end except when bounds: end
+ return(event${kind: 0,
+ value: 0,
+ mask: 0,
+ win: i2w(0),
+ sub: i2w(0),
+ x: 0,
+ y: 0,
+ x0: 0,
+ y0: 0,
+ time: 0})
+ end empty_event
+
+end x_input
projects / unix-history / commitdiff