% 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