#ifndef lint
static char sccsid[] = "@(#)input.c 9.6 88/02/10";
#endif

/*
 * Copyright (c) 1987 by Sun Microsystems, Inc. 
 */

/*
 * Keyboard and mouse input handling 
 *
 * input.c, Wed Mar 20 16:22:49 1985 
 *
 */

/*
 *	ToDo
 *	4	Suppose name/action is a compound object?
 *	5	Check keyword test
 *	7	Implement CurrentInputScene control
 *	11	Suppose array element is a compound object?
 *	12	Map signals to server into events
 */

#ifdef REF
#include <sys/types.h>
#include <ref/config.h>
#endif
#include "PostScript.h"
#include "input.h"
#include "cscript.h"
#include <cursor.h>

struct canvas
        *CanvasUnderMouse,      /* The canvas currently under the mouse */       
        *LastCanvasUnderMouse;  /* The canvas under the mouse the last time
                                   it moved */

struct queue_lock	 input_queue_lock;

struct body		*current_keystate;

struct body		*GlobalInterestList,
			*any_keyword,
			*enter_keyword,
			*exit_keyword;

static struct object	 any_keyword_obj;

struct execution_environment
			*event_logger;

static struct body	*Interested();
static void		 PostCrossings();
static unsigned int	 match_type();

#ifdef	DEBUG
PSFILE			*sysout, *syserr;
#endif /* DEBUG */

#ifdef	NOTDEF
/* Must go in operators.h 'cos it blocks */
static
awaitevent(ee)
    register struct execution_environment *ee;
{
}
#endif

static
createevent_primitive(ee)
    register struct execution_environment *ee;
{
    register struct body *b = createevent();

    set_typed_bodied_object(ee->optop, event_type, b);
    ee->optop++;
}

struct body *
createevent()
{
    register struct body *b = new_body(event);
    bzero(b, body_size(event));
    b->type = event_type;
    b->refcnt = 1;
    return b;
}

static
expressinterest(ee)
    register struct execution_environment *ee;
{				/* XXX - change the interest list
				 * representation */
    register struct object *optop = ee->optop - 1;
    register struct body *event;
    register struct canvas *cv;
    register struct body **il;

    if (optop->type != event_type) {
	ee->error_code = typecheck_error_code;
	return;
    }
    event = body_of(optop);
    if (event->body.event.is_queued) {
	ee->error_code = invalidaccess_error_code;
	return;
    }
    if (event->body.event.is_interest) {
	if (event->body.event.process == ee) {
	    decref(event);
	    ee->optop--;
	    return;
	}
	untangle_event(event);
    }
    event->body.event.name_match = match_type(&event->body.event.name);
    event->body.event.action_match = match_type(&event->body.event.action);
    if ((cv = event->body.event.canvas) == NULL)	/* global interest */
	il = &GlobalInterestList;
    else			/* canvas-specific interest */
	il = &((struct body *) cs_currentcanvasspare(cv))->body.canvas.interest;
#ifdef DEBUG
	check_il(*il);
#endif
    event->body.event.is_interest = 1;
    event->body.event.next_int = ee->interests;
    event->body.event.process = ee;
    event->body.event.serial = 0;
    ee->interests = event;
    while (*il && event->body.event.priority < (*il)->body.event.priority)
	il = &(*il)->body.event.next;
    if (!event->body.event.is_exclusive)
	    while (*il &&
	    	   (*il)->body.event.is_exclusive &&
	    	   (*il)->body.event.priority == event->body.event.priority)
		il = &(*il)->body.event.next;
    event->body.event.next = *il;
    *il = event;
#ifdef DEBUG
	check_il(*il);
#endif
     if (event->body.event.canvas != 0
	&& cs_getdamageshape(event->body.event.canvas) != 0)
	switch (event->body.event.name.type) {
	  case keyword_type:
	    if (body_of(&event->body.event.name) == damage_keyword)
		cs_addtodamqueue(event->body.event.canvas);
	    break;
	  case dictionary_type:{
		struct object   dam;

		set_typed_bodied_object(&dam, keyword_type, damage_keyword);
		if (find_object_in_dictionary(dam,
				       body_of(&event->body.event.name)) != 0)
		    cs_addtodamqueue(event->body.event.canvas);
	    }
	    break;
	}
    if (event->body.event.canvas)
	cv_decref(event->body.event.canvas);
    ee->optop--;
}

static unsigned int
match_type(obj)
    register struct object *obj;
{
    switch (obj->type) {
      case keyword_type:
	return (body_of(obj) == any_keyword) ? SimpleAnyMatch : DirectMatch;
      case array_type:{
	register int    st = obj->value.substring.start;
	register int    ln = obj->value.substring.length;
	register struct body *ar = body_of(obj);

	while (ln-- > st) {
	    if (ar->body.array.objects[ln].type == keyword_type &&
		body_of(ar->body.array.objects+ln) == any_keyword)
		return SimpleAnyMatch;
	}
	return DirectMatch;
      }
      case dictionary_type:
	return (find_object_in_dictionary(any_keyword_obj, body_of(obj)) ?
		DictAnyMatch : DirectMatch);
    }
    return DirectMatch;
}


static
expressboredom(ee)
    register struct execution_environment *ee;
{
    register struct object *optop = ee->optop - 1;
    register struct body   *event;

    if (optop->type != event_type) {
	ee->error_code = typecheck_error_code;
	return;
    }
    event = body_of(optop);
    if (!event->body.event.is_interest) {
	ee->error_code = invalidaccess_error_code;
	return;
    }
    untangle_event(event);
    decref(event);
    ee->optop--;
}

untangle_event(e)
    register struct body *e;
{
    register struct execution_environment *proc;
    assert(e->type == event_type);
    if (e->body.event.is_interest) {
	register struct body **il;
	proc = e->body.event.process;
	il = &proc->interests;
	assert(*il != 0);
	for (; *il; il = &(*il)->body.event.next_int)
	    if (*il == e) {		/* Remove from process' interests */
		*il = e->body.event.next_int;
		break;
	    }
	assert(*il==e->body.event.next_int);
	e->body.event.is_interest = 0;
	e->body.event.next_int = 0;
	e->body.event.process = 0;
	if (e->body.event.canvas) {	/* Remove from canvas' interests */
	    il = &((struct body *) cs_currentcanvasspare
		   (e->body.event.canvas))->body.canvas.interest;
	    if (e->body.event.canvas->refcnt > 0)
					/* Only inc the refcnt if we aren't
					   in the process of destroying the
					   canvas */
		cv_incref(e->body.event.canvas);
	    else
		e->body.event.canvas = 0;
	}
	else				/* Remove from global interests */
	    il = &GlobalInterestList;
	assert(*il);
#ifdef DEBUG
	{   register found = 0;
#endif	
	while (*il)
	    if (*il == e) {
		*il = e->body.event.next;
		decref(e);
#ifdef DEBUG
		found = 1;
#endif	
		break;
	    }
	    else
		il = &(*il)->body.event.next;
#ifdef DEBUG
	assert(found);
	}
#endif	
	if (proc->interests == 0
	    && proc->event == input_event_wait)
	    enqueue_process(proc);
	e->body.event.is_interest = 0;
#ifdef DEBUG
    } else {
	printf("untangle_event called on non-interest (0x%X)\n", e);
#endif	   
    }
}

static
sendevent(ee)
    register struct execution_environment *ee;
{
    register struct object *optop = ee->optop - 1;
    register struct body   *e;

    if (optop->type != event_type) {
	ee->error_code = typecheck_error_code;
	return;
    }
    e = body_of(optop);
    if (e->body.event.is_queued || e->body.event.is_interest) {
	ee->error_code = invalidaccess_error_code;
	return;
    }
    enqueueEvent(e);
/*     object_decref(optop); */
    ee->optop -= 1;
}

static
recallevent(ee)
    register struct execution_environment *ee;
{
    register struct object *optop = ee->optop - 1;
    register struct body   *e;

    if (optop->type != event_type) {
	ee->error_code = typecheck_error_code;
	return;
    }
    e = body_of(optop);
    if (e->body.event.is_queued)
	dequeueEvent(e);
    ee->optop--;
}

static
redistributeevent(ee)
    register struct execution_environment *ee;
{
    register struct body *e;
    register struct object *optop = ee->optop - 1;

    if (optop->type != event_type) {
	ee->error_code = typecheck_error_code;
	return;
    }
    e = body_of(optop);
    if (e->body.event.is_interest) {
	ee->error_code = invalidaccess_error_code;
	return;
    }
    distributeevent(e);
    distribution_count = 1;
    decref(e);
    ee->optop--;
}

void
determine_keystate(e)
    register struct body	*e;
{
    enum event_action { neither, down, up };
    register enum event_action	 this_action = neither;
    static enum event_action	 last_action;
    static struct object	 last_name;

    if (e->body.event.action.type == keyword_type) {
	register struct body *b = body_of(&e->body.event.action);

	if (b == up_keyword) {
	    this_action = up;
	    remove_keydown(&e->body.event.name);
	} else if (b == down_keyword) {
	    this_action = down;
	}
    }
    if (last_action == down &&
	(this_action == neither ||
	 !(equal_object(&last_name, &e->body.event.name)  ||
	   PerformCompare(last_name, e->body.event.name) == 2)))
	add_keydown(&last_name);
    object_decref(&last_name);
    last_name = e->body.event.name;
    object_incref(&last_name);
    last_action = this_action;
    e->body.event.keystate = current_keystate;
    incref(current_keystate);
}

static
add_keydown(name)
    register struct object *name;
{
    register int    count;
    register struct object *limit, *objects;
    register struct body *b;

    count = current_keystate->body.array.used;
    objects = current_keystate->body.array.objects + count;
    limit = current_keystate->body.array.objects;
    while (objects-- > limit) {
	if (equal_object(name, objects) ||
	    PerformCompare(*name, *objects) == 2)
	    return;
    }
    b = body_of(&make_growable_object(array_type,
				      current_keystate->body.array.objects,
				      ++count));
    limit = b->body.array.objects + count - 1;
    *limit = *name;
    for (objects = b->body.array.objects; objects <= limit; objects++)
	object_incref(objects);
    decref(current_keystate);
    current_keystate = b;
}

static
remove_keydown(name)
    register struct object *name;
{
    register int	    count, found = 0;
    register struct object *limit, *objects, *target;
    register struct body   *b;

    target = objects = current_keystate->body.array.objects;
    count = current_keystate->body.array.used - 1;
    limit = objects + count;
    while (target <= limit) {
	if (equal_object(name, target) ||
	    PerformCompare(*name, *target) == 2) {
	    found = 1;
	    break;
	}
	target++;
    }
    if (!found)
	return;
    b = new_array_body(count);
    for (objects = b->body.array.objects,
	 name = current_keystate->body.array.objects;
	 name <= limit;
	 name++) {
	if (name != target) {
	    *objects = *name;
	    object_incref(objects);
	    objects++;
	}
    }
    b->body.array.used = count;
    decref(current_keystate);
    current_keystate = b;
}

distributeevent(event)
    register struct body   *event;
{
    register struct body   *interest;
    register struct canvas *cv;
    register struct body   *e = (struct body *) 0;
    register int	    canvas_specified = 0;

    assert(event->type == event_type);
    if (event->body.event.interest) {
	decref(event->body.event.interest);
	event->body.event.interest = 0;
    }
    if (event_logger) {
	e = createevent();
	bcopy(event, e, body_size(event));
	e->refcnt = 1;
	e->body.event.next = 0;
	e->body.event.next_int = 0;
	event_inc_refs(e);
	deliverevent(e, event_logger);
    }
    if (cv = event->body.event.canvas) {
	canvas_specified = 1;
	if (cv->refcnt <= 0 || cv->signature != CANVASSIGNATURE) {
	    /* temporary bug work-around */
	    event->body.event.canvas = 0;
	    return;
	}
    }
    do {
	int             matched = 0;
	if (cv == (struct canvas *) 0) {
	    interest = GlobalInterestList;
	} else {
	    interest = ((struct body *)
			cs_currentcanvasspare(cv))->body.canvas.interest;
	}
	while (interest != (struct body *) 0) {
	    assert(interest->type == event_type);
	    assert(interest->body.event.is_interest);
	    if (e = Interested(interest, event)) {
		if (cv && !canvas_specified) {
		    e->body.event.canvas = cv;
		    cv_incref(cv);
		}
		deliverevent(e, interest->body.event.process);
		distribution_count++;
		if (interest->body.event.is_exclusive)
		    return;
		matched = 1;
	    }
	    interest = interest->body.event.next;
	}
	if (canvas_specified  ||
	    cv && (cv->events_consumed == AllEvents ||
		   (cv->events_consumed == MatchedEvents && matched)) ||
	    (cv == (struct canvas *) 0  &&  matched))
	    return;
	if (cv == (struct canvas *) 0)
	    cv = cs_locatecanvasinscene(CurrentInputScene,
					cfloorfr(event->body.event.pos.x),
					cfloorfr(event->body.event.pos.y));
	else
	    cv = cs_nextcanvasforpoint(cv, cfloorfr(event->body.event.pos.x),
					   cfloorfr(event->body.event.pos.y));
    } while (cv != (struct canvas *) 0);
}

/*
 *	Does the interest *inb match the event *evb?
 *	If so,  post to the process interested
 */
static struct body *
Interested(inb, evb)
    register struct body *inb;
    struct body    *evb;
{
    int             replace_action = 0, replace_name = 0;
    struct object   new_action, new_name;
    register struct body *e;

    assert(evb->type == event_type);
    assert(inb->type == event_type && inb->body.event.is_interest);
    if (inb->body.event.serial >= evb->body.event.serial)
	return 0;
    if (evb->body.event.process) {
	if (evb->body.event.process != inb->body.event.process)
	    return 0;
    }
    if (!match_fields(&inb->body.event.name, &evb->body.event.name,
		      inb->body.event.name_match, &new_name, &replace_name))
	return 0;
    if (!match_fields(&inb->body.event.action, &evb->body.event.action,
		inb->body.event.action_match, &new_action, &replace_action))
	return 0;
    QALLOC(e, body_size(event), (struct body *));
    bcopy(evb, e, body_size(event));
    e->refcnt = 1;
    e->body.event.interest = inb;
    e->body.event.is_interest = 0;
    event_inc_refs(e);
    if (replace_name) {
	if (new_name.executable) {
	    object_decref(&e->body.event.runnable_match);
	    e->body.event.runnable_match = new_name;
	} else {
	    object_decref(&e->body.event.name);
	    e->body.event.name = new_name;
	}
	object_incref(&new_name);
    }
    if (replace_action) {
	if (new_action.executable) {
	    if (e->body.event.runnable_match.type != null_type)
		add_runnable_action(e, &new_action);
	    else
		e->body.event.runnable_match = new_action;
	} else {
	    object_decref(&e->body.event.action);
	    e->body.event.action = new_action;
	}
	object_incref(&new_action);
    }
    inb->body.event.serial = e->body.event.serial;

    return e;
}

static int
add_runnable_action(e, action)
    register struct  body  *e;
    register struct object *action;
{
    register struct  body  *form;
    struct object	    name;

    name = e->body.event.runnable_match;
    e->body.event.runnable_match = make_array(2);
    form = body_of(&e->body.event.runnable_match);
    form->body.array.objects[0] = name;
    form->body.array.objects[1] = *action;
}

static int
match_fields(i_field, e_field, match_type, replacement, replace_flag)
    register struct object *i_field, *e_field, *replacement;
    unsigned int match_type;
    int            *replace_flag;
{
    if (match_type == SimpleAnyMatch)
	return 1;		/* matches anything */
    switch (i_field->type) {
      case null_type:
	return 1;		/* Null matches anything */

      case boolean_type:
      case cons_type:
      case marker_type:
      case operator_type:
      case called_operator_type:
      case font_id_type:
      case event_type:
      case file_type:
      case canvas_type:
      case process_type:
      case shape_type:
	return 0;		/* These lack sensible interpretations */

      case fixed_type:
      case real_type:
      case keyword_type:
	return (equal_object(e_field, i_field));

      case string_type:
	return (e_field->type == string_type &&
		PerformCompare(*e_field, *i_field) == 2);

      case array_type:		/* Match on any of the elements in the array */
	{
	    register int    st = i_field->value.substring.start;
	    register int    ln = i_field->value.substring.length;
	    register struct body *ar = body_of(i_field);

	    if (st > ar->body.array.size)
		return 0;
	    if (st + ln > ar->body.array.size)
		ln = ar->body.array.size - st;
	    while (ln--) {
		if (equal_object(e_field, &(ar->body.array.objects[st])) ||
		    PerformCompare(*e_field, ar->body.array.objects[st]) == 2)
		    return 1;
		/* XXX - suppose array element is a compound object? */
		st++;
	    }
	    return 0;
	}

      case dictionary_type: {
	register struct object *val;
	extern struct object *find_object_in_dictionary();

	val = find_object_in_dictionary(*e_field, body_of(i_field));
	if (val == 0) {
	    val = find_object_in_dictionary(any_keyword_obj,
					    body_of(i_field));
	    if (val == 0)
		return 0;
	}
	*replace_flag = 1;
	*replacement = *val;
	return 1;
      }
    }
    return 0;			/* default, and to keep Lint happy */
}

static
deliverevent(b, ee)
    register struct body *b;
    register struct execution_environment *ee;
{
    if (ee->eq_head == NULL) {		/* queue was empty */
	ee->eq_head = ee->eq_tail = b;
	if (ee->event == input_event_wait)
	    enqueue_process(ee);
    } else {
	b->body.event.next = NULL;
	ee->eq_tail->body.event.next = b;
	ee->eq_tail = b;
    }
}

static
setcursorlocation_primitive(ee)
    register struct execution_environment *ee;
{
    register struct object *optop = ee->optop - 2;
    fract           fx, fy;
    int             x, y;

    switch (object_type_pair(optop[0], optop[1])) {
      case tp(fixed, fixed):
	cs_frtransform(&(ee->gontext),
		       optop[0].value.fixed,
		       optop[1].value.fixed,
		       &fx, &fy);
	break;
      case tp(fixed, real):
	cs_frtransform(&(ee->gontext),
		       optop[0].value.fixed,
		       fractf(optop[1].value.real),
		       &fx, &fy);
	break;
      case tp(real, fixed):
	cs_frtransform(&(ee->gontext),
		       fractf(optop[0].value.real),
		       optop[1].value.fixed,
		       &fx, &fy);
	break;
      case tp(real, real):
	cs_frtransform(&(ee->gontext),
		       fractf(optop[0].value.real),
		       fractf(optop[1].value.real),
		       &fx, &fy);
	break;
      default:
	ee->error_code = typecheck_error_code;
	return;
    }
    cs_canvastoscreen(cs_currentcanvas(&ee->gontext),
		      cfloorfr(fx),
		      cfloorfr(fy),
		      &x, &y);
    setcursorposition(x, y);
    ee->optop -= 2;
}

static
currenttime_primitive(ee)		/* - => minutes.fract */
    register struct execution_environment *ee;
{
    set_typed_object(ee->optop, fixed_type);
    ee->optop->value.fixed = currenttime(0);
    ee->optop++;
}

static
lasteventtime_primitive(ee)		/* - => minutes.fract */
    register struct execution_environment *ee;
{
    set_typed_object(ee->optop, fixed_type);
    ee->optop->value.fixed = last_event_time;
    ee->optop++;
}

void
SetCanvasUnderMouse(scene, x, y, time)
    struct scene *scene;
    fract         x, y, time;
{
    struct canvas *cv = cs_locatecanvasinscene(scene, cfloorfr(x), cfloorfr(y));

    LastCanvasUnderMouse = CanvasUnderMouse;
    CanvasUnderMouse = cv;
    if (CanvasUnderMouse != LastCanvasUnderMouse) {
	PostCrossings(x, y, time);
	/* Change the cursor tracking image NEW */
	cs_setcursorcanvas(CanvasUnderMouse);
    }
}

CheckCrossings(time)
    fract           time;
{
    SetCanvasUnderMouse(CurrentInputScene,
		        cv_cursor.ri.pos.x, cv_cursor.ri.pos.y,
		        time);
}

#define LISTSIZE	30
static	void
PostCrossings(x, y, time)
    fract           x, y, time;
{
    register struct body *b,
               *newb;
    struct canvas *NewList[LISTSIZE],
               *OldList[LISTSIZE];
    register struct canvas **ListP,
              **NewListP,
              **OldListP;
    register struct canvas *cv;
    register int detail;

    if (CanvasUnderMouse == LastCanvasUnderMouse)
	return;
    for (cv = LastCanvasUnderMouse, OldListP = OldList;
	    OldListP < OldList + LISTSIZE;) {
	*OldListP++ = cv;
	if (cv == (struct canvas *) 0)
	    break;
	else
	    cv = cv->parent;
    }
    for (cv = CanvasUnderMouse, NewListP = NewList;
	    NewListP < NewList + LISTSIZE;) {
	*NewListP++ = cv;
	if (cv == (struct canvas *) 0)
	    break;
	else
	    cv = cv->parent;
    }
    while (NewListP > NewList && OldListP > OldList
	    && NewListP[-1] == OldListP[-1]) {
	NewListP--;
	OldListP--;
    }				/* now both ListPs point to least common
				 * ancestor */
    /* or there is none */
    assert(NewList[0] == (struct canvas *) 0 || OldList[0] == (struct canvas *) 0 || (NewListP[0] == OldListP[0] && (NewListP == NewList || OldListP == OldList || NewListP[-1] != OldListP[-1])));
    b = createevent();
    set_typed_bodied_object(&b->body.event.name, keyword_type, exit_keyword);
    set_typed_object(&b->body.event.action, fixed_type);
    b->body.event.pos.x = x;
    b->body.event.pos.y = y;
    b->body.event.time = time;
    if (OldList[0]) {
	ListP = OldList;
	detail = 0;
	do {
	    if ((*ListP)->refcnt > 0) {
		b->body.event.action.value.fixed =
		    fracti(*ListP == *NewListP ? 1 : detail);
		b->body.event.canvas = *ListP;
		cv_incref(*ListP);
		newb = createevent();
		bcopy(b, newb, body_size(event));	/* *newb = *b; */
		newb->body.event.canvas = 0;
		enqueueEvent(b);
		b = newb;
	    }
	    detail = 2;
	} while (++ListP < OldListP && *ListP);
    }
    set_typed_bodied_object(&b->body.event.name, keyword_type, enter_keyword);
    if (NewList[0]) {
	ListP = NewList;
	detail = 0;
	do {
	    if ((*ListP)->refcnt > 0) {
		b->body.event.action.value.fixed =
		    fracti(*ListP == *OldListP ? 1 : detail);
		b->body.event.canvas = *ListP;
		cv_incref(*ListP);
		newb = createevent();
		bcopy(b, newb, body_size(event));	/* *newb = *b; */
		newb->body.event.canvas = 0;
		enqueueEvent(b);
		b = newb;
	    }
	    detail = 2;
	} while (++ListP < NewListP && *ListP);
    }
    decref(b);
}

static int
countinputqueue(ee)
    register struct execution_environment *ee;
{
    register struct body *b = ee->body_handle;
    register struct body *p;
    register int i;

    if (b->body.process.env->eq_head == NULL)
	i = 0;
    else if (b->body.process.env->eq_tail == b->body.process.env->eq_head)
	i = 1;
    else
	for (i = 0,p = b->body.process.env->eq_head; p; p = p->body.event.next)
	    i++;
    set_fixed_object(ee->optop, fracti(i));
    ee->optop += 1;
}

static int
blockinputqueue_primitive(ee)
    register struct execution_environment *ee;
{
    register struct object *optop = ee->optop - 1;
    register fract	    timeout;

    switch (optop->type) {
    case fixed_type:
	timeout = optop->value.fixed;
	break;
    case real_type:
	timeout = fractf(optop->value.real);
	break;
    case null_type:
	timeout = DEFAULT_INPUT_QUEUE_TIMEOUT;
	break;
    default:
	ee->error_code = typecheck_error_code;
	return;
    }
    if (timeout < 0) {
	ee->error_code = rangecheck_error_code;
	return;
    }
    if (input_queue_lock.count < 0) {
	input_queue_lock.count = 1;
#ifdef DEBUG
	printf("Input lock count reset to 1 when a block operation followed a timeout.\n");
#endif
    } else {
	input_queue_lock.count++;
    }
    input_queue_lock.timer = currenttime(0) + timeout;
    ee->optop--;
}

static int
unblockinputqueue_primitive(ee)
    register struct execution_environment *ee;
{
    if (input_queue_lock.count ==  0) {
	ee->error_code = rangecheck_error_code;
	return;
    } else if (input_queue_lock.count < 0)
	++input_queue_lock.count;
    else
	--input_queue_lock.count;
}


static
geteventlogger(ee)
    register struct execution_environment *ee;
{
    register struct object *optop = ee->optop;

    if (event_logger) {
	set_typed_bodied_object(optop, process_type,
				event_logger->body_handle);
	object_incref(optop);
    } else
	clear_object(optop);
    ee->optop++;
}

static
seteventlogger(ee)
    register struct execution_environment *ee;
{
    register struct object *optop = ee->optop - 1;
    register struct
    execution_environment *proc;

    switch (optop->type) {
      case process_type:
	event_logger = body_of(optop)->body.process.env;
	break;
      case null_type:
	event_logger = 0;
	break;
      default:
	ee->error_code = typecheck_error_code;
	return;
    }
    ee->optop--;
}

void
return_interests(list, ee)
    register struct body *list;
    struct execution_environment *ee;
{
    register u_int  n;
    register struct body *in, *ar;
    register struct object *dest;
    struct object  *optop = ee->optop;

    for (in = list, n = 0; in; in = in->body.event.next, n++) {
	assert(in->body.event.is_interest);
    }
    *ee->optop = make_array(n);
    ar = body_of(ee->optop);
    ar->body.array.used = n;
    for (dest = ar->body.array.objects, in = list; n--; dest++) {
	incref(in);
	set_typed_bodied_object(dest, event_type, in);
	in = in->body.event.next;
    }
    ee->optop++;
}

static
global_interests()
{
    return_interests(GlobalInterestList, current_process);
}

#ifdef DEBUG
static char	    nolabel[] = "",
		    alabel[] = "add: ",
		    rlabel[] = "rem: ";

p_obj(label, obj)
    char           *label;
    struct object  *obj;
{
    struct body    *b;

    printf(label);
    if (object_has_body(obj)) {
	b = body_of(obj);
	if (obj->type != b->type) {
	    printf("*obj/body mismatch*");
	    return;
	}
    }
    switch (obj->type) {
      case null_type:
	printf("null");
	break;
      case array_type:
	printf("%c0X%x%c", (obj->executable ? '{' : '['),
	       b, (obj->executable ? '}' : ']'));
	break;
      case dictionary_type:
	printf("dict[0X%x]", b);
	break;
      case keyword_type:
	printf("/%s", b->body.keyword.namelen, b->body.keyword.name);
	break;
      case fixed_type:
	printf("%d.%05d", obj->value.fixed >> 16, obj->value.fixed & 0xffff);
	break;
      case event_type:
	printf("event(0x%x)", b);
	break;
      default:
	printf("0x%x");
    }
}

p_event(e)
    struct body    *e;
{
    printf("ev(%x): ", e);
    if (e)
	if (e->type != event_type) {
	    printf("not an event\n");
	    return;
	}
    printf("refs: %d time: %d ser: %d [%d %d] cv: 0X%x proc: 0X%x ",
	   e->refcnt,
	   e->body.event.time,
	   e->body.event.serial,
	   e->body.event.pos.x >> 16,
	   e->body.event.pos.y >> 16,
	   e->body.event.canvas,
	   e->body.event.process);
    if (e->body.event.is_interest)
	printf("%s interest, priority %d ",
	       e->body.event.is_exclusive ? "excl." : "",
	       e->body.event.priority);
    printf("\n");
    p_obj("\tname", &e->body.event.name);
    p_obj(" action", &e->body.event.action);
    p_obj(" c_data", &e->body.event.client_data);
    printf("\n");
}

p_q()
{
    register struct body *e;

    printf("queue: %x\n", eventq);
    for(e = eventq; e; e = e->body.event.next)
	p_event(e);
    printf("\n");
}

check_il(il)
    register struct body *il;
{

    while (il) {
	if (il->refcnt <= 0) {
	    printf("interest list contains freed event!\n");
	    abort();
	}
	if (il->type != event_type) {
	    printf("interest list contains non-event!\n");
	    abort();
	}
	if (!il->body.event.is_interest) {
	    printf("interest list contains non-interest!\n");
	    abort();
	}
	if (il->body.event.next == il) {
	    printf("interest list cycle!\n");
	    abort();
	}
	il = il->body.event.next;
    }
}

check_q()
{
    register struct body *e = eventq;

    while (e) {
	if (e->refcnt <= 0) {
	    printf("eventq contains freed event!\n");
	    abort();
	}
	if (e->type != event_type) {
	    printf("eventq contains non-event!\n");
	    abort();
	}
	if (e->body.event.next == e) {
	    printf("eventq cycle!\n");
	    abort();
	}
	e = e->body.event.next;
    }
}

check_inwait1(cv)
    register struct canvas *cv;
{
    while (cv) {
	register struct body *b;
	check_inwait1(cv->topchild);
	b = ((struct body *)
	     cs_currentcanvasspare(cv))->body.canvas.interest;
	while (b) {
	    assert(b->body.event.is_interest);
	    assert(b->body.event.process);
	    assert(b->body.event.process->pos < b->body.event.process->execution_stack || b->body.event.process->pos->type != array_body_execution || b->body.event.process->pos->executed.type == array_type);
	    b = b->body.event.next;
	}
	cv = cv->prev;
    }
}

check_inwait() {
    if (CurrentInputScene)
	check_inwait1(CurrentInputScene->canvases);
    return 1;
}

#endif /* DEBUG */

initialize_input()
{
    any_keyword = get_name("AnyValue", -1);
    set_typed_bodied_object(&any_keyword_obj, keyword_type, any_keyword);
    current_keystate = new_array_body(0);
    enter_keyword = get_name("EnterEvent", -1);
    exit_keyword = get_name("ExitEvent", -1);
#ifdef	DEBUG
    sysout = psio_stdout;
    syserr = psio_stderr;
#endif /* DEBUG */
    define_operator("blockinputqueue", blockinputqueue_primitive, 0, 1, 0);
    define_operator("countinputqueue", countinputqueue, 0, 0, 1);
    define_operator("createevent", createevent_primitive, 0, 0, 1);
    define_operator("currenttime", currenttime_primitive, 0, 0, 1);
    define_operator("expressinterest", expressinterest, 0, 1, 0);
    define_operator("geteventlogger", geteventlogger, 0, 0, 1);
    define_operator("globalinterestlist", global_interests, 0, 0, 1);
    define_operator("lasteventtime", lasteventtime_primitive, 0, 0, 1);
    define_operator("recallevent", recallevent, 0, 1, 0);
    define_operator("redistributeevent", redistributeevent, 0, 1, 0);
    define_operator("revokeinterest", expressboredom, 0, 1, 0);
    define_operator("sendevent", sendevent, 0, 1, 0);
    define_operator("setcursorlocation", setcursorlocation_primitive, 0, 2, 0);
    define_operator("seteventlogger", seteventlogger, 0, 1, 0);
    define_operator("unblockinputqueue", unblockinputqueue_primitive, 0, 0, 0);
}